BETA TurboCAD SDK Documentation

July 20, 2001 Edition

Please see the What's New page for information on this release. The preliminary release of the SDK (for testing and evaluation only) is available at the download page. Contributed banner art (submit yours!) can be seen on the banners page.

TurboCAD SDK Documentation

This site is a preview of the first major revision of the TurboCAD SDK since it was created for TurboCAD version 4. We hope you'll spend some time looking over the documentation we're presenting on the site, and let us know what you think. In order to help you help us, we've added an interactive commenting system for each of the over 600 pages on the site.

Requirements

This site uses the Microsoft Html Help ActiveX control to organize the topics under a Table of Contents and Index, and requires the use of Internet Explorer for Windows, version 4 for or later. In addition you must have the Html Help control already installed on your computer, or allow the ActiveX download that you'll be prompted for when you first visit the site. For more information on upgrading and installing the latest version of this control, please visit the pages on Microsoft's web site.

What We're Doing

The TurboCAD team is working on improving the overall quality of the TurboCAD programming interfaces as well as the documentation describing them. We're in the process of completing a quality review of the TurboCAD SDK, fixing several known issues, and adding new functionality and samples. We hope that you find the documentation on this site is more useful and easier to use than in previous releases.

When finalized, the SDK documentation will be posted on the main TurboCAD.com website as well as packaged as a compiled help file as part of a maintenance release of TurboCAD Professional.

Be sure to check the What's New page in this section to stay up to date with our progress.

We Want to Hear from You

We've recently gathered some good information from you, our users, and we hope we're going to give you a lot more programming power in future releases of TurboCAD. Keep on letting us know if we're doing what needs to be done. We're providing an email address that you can use to send us your thoughts:

tcsdkbeta@imsisoft.com

Feel free to use this address to contact our team about any issues concerning the existing SDK, the documentation on this site, or what you'd like to see us do in future releases. If you'd like to be a beta tester for a new version of TurboCAD 7 and the updated SDK, email us with your contact information and a request for becoming a member of the SDK beta test program. We'll give out information on the testing and release schedules for the SDK to our beta testers when they become available.


What's New In This Beta

Release Notes: What's New in This Beta

July 20, 2001

The documentation now includes license agreements for SDK end-users (for building SDK projects on a single machine) and for developers (royalties required; for distributing SDK projects to others). We have also added a list of re-distributable files for end-users and developers. Please review these and let us know if there are any issues that need to be clarified.

July 13, 2001

The Advanced Projects section has been added to the documentation. This is where to look for information on how to build standalone CAD applications, ActiveX controls, servers, and custom extensions to TurboCAD. We hope you'll give us your feedback.

July 1, 2001

The preliminary SDK is now available for download! Please visit the download page to get your copy. We encourage you to use the new SDK. We hope that you will give us your valuable feedback on all aspects of using the SDK, including licensing terms (what you'd like to see), SDK installation, the documentation (including F1-key enabled integrated VB and VBA help), and samples. We will be trying to finalize the "Advanced Projects" section in the next two weeks, and we'd like to include any other items that you think we've left out.

June 1, 2001

81 VBA, Visual Basic, Visual C++, and VBScript samples have been added to the website and to the compiled help file; you can browse them by going to the Example Projects section of the documentation in the Contents pane of the website. Full text search capabilities in the online and compiled versions should produce results that include these samples.

We are reading your online posted comments. Due to scheduling issues, some of the improvements you have kindly suggested don't appear in this June 1 release, but we will incorporate them as soon as possible. Our next milestone is to include a first draft of the "Advanced Projects" section. Look for it in the next two weeks. After that, we plan a general revision of all topics, and we'll try to bring your comments into the documentation. Please continue to support this effort with your comments. We do appreciate it!

We've also made substantial progress in producing small code snippets that will appear in the descriptive "Exploring In Depth" section. These will be appearing on the site in the next release also.

May 18, 2001

The documentation is now available as a compiled HtmlHelp (.CHM) file for your inspection. &nsbpHowever, we strongly engcourage you to continue to use the online version so that you can post or email us with comments and suggestions. The compiled help file will be shipped with a beta version of the SDK for your testing in the near future.

The reference section has been brought in sync with the (final?) list of objects, events, methods and properties that will be included in the next SDK release, and unimplemented and/or hidden methods and properties have been removed.

Functionality of the documentation system has been improved in two ways. Support for F1 context-sensitive help in VBA has been added to the compiled help file, and to the SDK type libraries. Applies To, Methods, and Properties HtmlHelp links have been added for all objects, methods and properties. The next release will attempt to complete the See Also and Example links.

Description text has been added to the reference method and property topics. Where available from our source code, descriptions of all method and property parameters and return values are shown. Where the descriptions are missing, this has been noted. Hopefully, the next issue of the beta documentation will have these descriptions and those for objects and events completed.

May 4, 2001

We've built dynamic online versions of the HtmlHelp search and linking systems, as well as using the HtmlHelp control for the table of contents and keyword system. The keywords will be expanded towards the end of the documentation release cycle.

There is also a dynamic comment and email feedback system on the site that we encourage you to use to tell us about spelling and content errors and omissions on a per-topic basis.

The newly written documentation has been organized into five sections, comprising over 600 individual topics and has been posted on the beta site.

  • Site Notes This contains information just for the beta program: announcements, how-to instructions, and links to other TurboCAD SDK sites.

  • Overview This contains general information on using the SDK, VBA, and where to get more information.

  • In Depth This contains narrative, task-oriented explanations on how to use the events, objects, methods and properties in the SDK, organized as linearly as we think is possible. We hope that you'll find this section the most useful in quickly explaining "how-to" concepts that will get you up to speed fast, while giving a complete coverage of the SDK.

  • Examples This contains an indexed (soon to be keyworded), catalog of new and revised samples.

  • Reference This is the syntax reference for Visual Basic for Applications for every event, object, method and property in the SDK. While it is not yet complete, take a look at the Vertex object documentation as an example.

Please note that we are giving you an early preview of the documentation. You'll see portions of the topics that are incomplete. These are usually denoted by appearing in red text or by being enclosed in [[[Triple brackets]]]. We're working on the documentation as you read this, so bear with us. Apart from these "under construction" parts, we're very interested in finding out what you you think we have done a poor job in explaining, or areas that we haven't addressed that you feel are important.

We need a banner graphic to use in the top frame! Post your suggestions, or send us a 40x400 image if have something you think is appropriate.


TURBOCAD SDK END-USER LICENSE AGREEMENT

A. GENERAL AND DEFINITIONS

1. The TurboCAD application ("TurboCAD") and the TurboCAD SDK ("SDK", collectively TurboCAD and the SDK will be referred to as the "Product") are proprietary to International Microcomputer Software, Inc. ("IMSI"), and are protected by Federal Copyright Law. IMSI retains the title to and ownership of all contents of the TurboCAD application and SDK, except those parts licensed to IMSI by others.

2. TurboCAD consists of binary application files and libraries, content, described in total as the "TurboCAD Components". Depending on the type of license that Licensee has chosen, the SDK may consist of documentation, sample applications, tools and utilities, miscellaneous technical information, development toolkits, server applications, and development tools (each, a "Component," and collectively "Components," of the Product). The Product may include groups of Components identified as any one or more of the following: Libraries, Headers, Sample Code, and Documentation. This license defines the rights of the Licensee's rights to use and distribute these Components.

3. The laws of the State of California govern this Agreement. If any provisions are held void or unenforceable, the remainder shall remain valid and enforceable according to its terms.

4. When conflicting language exists between this Agreement and any other agreement included in TurboCAD or the SDK, this Agreement shall supersede. If either Licensee or IMSI employs attorneys to enforce any rights arising out of or relating to this Agreement, the prevailing party shall be entitled to recover reasonable attorneys' fees. Licensee acknowledges that Licensee has read this Agreement, understands it and that it is the complete and exclusive statement of Licensee's agreement with IMSI, which supersedes any prior agreement, oral or written, between Licensee and IMSI with respect to the licensing to Licensee of this SDK. No variation of the terms of this Agreement will be enforceable against IMSI unless IMSI gives its express consent, in writing signed by an authorized signatory of IMSI.

5. Pursuant to the terms and conditions of this Agreement, Licensee is granted a nonexclusive license to use, modify and create derivative works ("Derivative Works") that incorporate source or binary Components included in the SDK.

B. GRANT OF RIGHT TO USE

1. Licensee acknowledges that the Product is of U.S. origin. Licensee agrees to comply with all applicable international and national laws that apply to the Product, including the U.S. Export Administration Regulations, as well as end-user, end-use and destination restrictions issued by U.S. and other governments.

2. Licensee may make a limited number of copies of the SDK to be used by Licensee's employees or consultants for internal development purposes and not for general business purposes or for distribution by any means, and such employees or consultants shall be subject to this Agreement.

3. Unless Licensee obtains a separate Developer License from IMSI, Licensee may use TurboCAD and SDK Components solely for the purpose of internal development, testing or evaluation. Licensee may not:

a. Include TurboCAD and SDK Components in Bundled Products distributed to any third party, or

b. Sell, sublicense, rent, loan or lease TurboCAD and SDK Components to any third party.

C. CONDITIONS OF LICENSE

1. Licensee may not reverse engineer, decompile, disassemble or otherwise reduce the binary object code Components to a humanly perceivable form for any purposes whatsoever, in whole or in part, except and only to the extent that it is expressly permitted by applicable law notwithstanding this limitation.

2. Some of the TurboCAD and SDK components include technology that is licensed by IMSI from Lightwork Design, Limited ("Lightwork") and from Spatial Technologies, Inc. ("Spatial"), as indicated in the "REDIST.TXT" file. IMSI offers no rights for use or distribution of such technology beyond those rights granted by the TurboCAD End-User License Agreement. Licensee must apply for separate licenses from Lightwork and Spatial in order to obtain rights to distribute components that include technology of IMSI's licensors.

3. Licensee agrees that Licensee will treat the Components of the SDK and any Derivative Works with the same degree of care as Licensee accord to Licensee’s own confidential information, which Licensee exercises reasonable care to protect. Licensee’s obligations under this section with respect to particular Components of the SDK shall terminate when Licensee can document that:

a. The Components were in the public domain at or subsequent to the time they were communicated to Licensee by IMSI through no fault of Licensee’s;

b. The Derivative Works were developed by Licensee’s employees or agents independently of and without reference to any information communicated to Licensee by IMSI; or

c. The communication was in response to a valid order by a court or other governmental body, was otherwise required by law, or was necessary to establish the rights of either party under this Agreement.

4. Licensee agrees to protect IMSI's copyright and other ownership interests in all items in this SDK. Licensee agrees that all copies of items in this SDK reproduced for any reason by Licensee will contain the same copyright, trademark, and other proprietary notices as appropriate, as appear on or in the master items delivered by IMSI in this SDK. IMSI and/or its licensors retain title and ownership of the items in this SDK, the media on which it is recorded, and all subsequent copies, regardless of the form or media in or on which the original and other copies may exist. Except as stated herein, this Agreement does not grant Licensee any rights to patents, copyrights, trade secrets, trademarks or any other rights in respect to the items referred to by this Agreement.

D. US GOVERNMENT RESTRICTED RIGHTS

1. Use, duplication or disclosure by the United States Government is subject to restrictions as set forth under FARS 52.227-14, in FARS 52.227-19 or in DFARS 52.227-7013(c)(1)(ii) Commercial Computer Software - Restricted Rights.

E. ASSIGNMENT

1. This Agreement shall inure to the benefit of, and be binding upon, the parties hereto and their successors and legal heirs, but shall not be assignable by either party to any third party except with the prior written consent of the other party. Such consent will not be unreasonably withheld.

F. INDEMNIFICATION

1. Licensee agrees to indemnify, hold harmless, and defend IMSI from and against any claims or lawsuits, including attorneys' reasonable fees, that arise or result from the use or distribution of Bundled Products, provided that IMSI gives Licensee prompt written notice of any such claim, tenders to Licensee the defense or settlement of such a claim at Licensee’s expense and cooperates with Licensee, in defending or settling such claim.

G. TERM

1. This Agreement shall remain in effect until terminated. Licensee may terminate the Agreement at any time by ceasing to manufacture and distribute Derivative Works and Bundled Products of which the SDK is a component, and destroying all copies of the SDK Components.

2. The Agreement will also terminate upon Licensee’s failure to comply with the provisions of this Agreement, or in the event that Licensee becomes subject to any bankruptcy or insolvency proceeding under Federal or state statutes or becomes insolvent.

3. Upon any cause of termination, Licensee must cease to manufacture products of which the SDK is a component and must destroy all copies of the Product and all of its component parts.

4. Section E (Assignment) of this Agreement shall survive any termination.

H. LIMITED WARRANTY

1. IMSI makes no warranty as to the operational performance of the SDK, the accuracy, completeness or usefulness of any information provided with this SDK, or the advisability of using the SDK in conducting Licensee’s business. The SDK is provided "as is" without warranty or representation, either express or implied, as to performance, merchantability or fitness for any particular purpose. The entire risk as to the quality and performance of the SDK is assumed by the licensee.

2. IMSI warrants that the diskettes/CD-ROM on which the Program is furnished will be free from defects in materials and workmanship under normal usage for a period of ninety (90) days from the date of original purchase. Licensee's sole and exclusive remedy in the event of a defect is expressly limited to the replacement of the diskettes/CD-ROM.

3. Because software is inherently complex and may not be completely free of errors, Licensee is advised to verify Licensee’s work and to make backup copies. In no event shall IMSI Software or anyone else who has been involved in the creation, production or delivery of this SDK be liable for any direct, indirect, special, incidental or consequential damages, such as, but not limited to, loss of anticipated profits, business interruption, benefits, use, or data resulting from the use of this SDK, or arising out of any breach of any warranty. Some states do not allow the exclusions or limitation of direct, incidental or consequential damages so the above limitation may not apply to Licensee.

I. CONSEQUENTIAL DAMAGES WAIVER

1. EXCEPT FOR A BREACH OF ANY LICENSE GRANT TO LICENSEE HEREUNDER OR UNDER THE AGREEMENT, IN NO EVENT SHALL EITHER PARTY BE LIABLE FOR ANY INDICENTAL, CONSEQUENTIAL, PUNITIVE OR SPECIAL DAMAGES, LOST PROFITS OR LOST DATA, OR ANY OTHER INDIRECT DAMAGES, EVEN IF SUCH PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.

J. ACCEPTANCE

1. INSTALLING THIS SDK INDICATES LICENSEE’S ACCEPTANCE OF THE FOREGOING AGREEMENT. IF LICENSEE CHOOSES TO DECLINE THE FOREGOING AGREEMENT, LICENSEE SHOULD CANCEL THE INSTALL PROCESS.


TURBOCAD SDK DEVELOPER LICENSE AGREEMENT

Company: _________________________________________

Primary Contact: _________________________________

Licensed Components:

Core _________ Filters _________ Lightwork _________ Spatial __________

A. GENERAL AND DEFINITIONS

1. The TurboCAD application ("TurboCAD") and the TurboCAD SDK ("SDK", collectively TurboCAD and the SDK will be referred to as the "Product") are proprietary to International Microcomputer Software, Inc. ("IMSI"), and are protected by Federal Copyright Law. IMSI retains the title to and ownership of all contents of the TurboCAD application and SDK, except those parts licensed to IMSI by others.

2. TurboCAD consists of binary application files and libraries, content, described in total as the "TurboCAD Components". Depending on the type of license that Licensee has chosen, the SDK may consist of documentation, sample applications, tools and utilities, miscellaneous technical information, development toolkits, server applications, and development tools (each, a "Component," and collectively "Components," of the Product). The Product may include groups of Components identified as any one or more of the following: Libraries, Headers, Sample Code, and Documentation. This license defines the rights of the Licensee's rights to use and distribute these Components.

3. The laws of the State of California govern this Agreement. If any provisions are held void or unenforceable, the remainder shall remain valid and enforceable according to its terms.

4. When conflicting language exists between this Agreement and any other agreement included in TurboCAD or the SDK, this Agreement shall supersede. If either Licensee or IMSI employs attorneys to enforce any rights arising out of or relating to this Agreement, the prevailing party shall be entitled to recover reasonable attorneys' fees. Licensee acknowledges that Licensee has read this Agreement, understands it and that it is the complete and exclusive statement of Licensee's agreement with IMSI, which supersedes any prior agreement, oral or written, between Licensee and IMSI with respect to the licensing to Licensee of this SDK. No variation of the terms of this Agreement will be enforceable against IMSI unless IMSI gives its express consent, in writing signed by an authorized signatory of IMSI.

5. Pursuant to the terms and conditions of this Agreement, Licensee is granted a non-exclusive license to use, modify and create derivative works ("Derivative Works") that incorporate source or binary Components included in the SDK, and to distribute compiled version of such Derivative Works in object code format solely as incorporated in the object code format of such Products ("Bundled Products").

B. GRANT OF RIGHT TO USE

1. Licensee acknowledges that the Product is of U.S. origin. Licensee agrees to comply with all applicable international and national laws that apply to the Product, including the U.S. Export Administration Regulations, as well as end-user, end-use and destination restrictions issued by U.S. and other governments.

2. Licensee may make a limited number of copies of the SDK to be used by Licensee's employees or consultants for internal development purposes and not for general business purposes or for distribution by any means, and such employees or consultants shall be subject to this Agreement.

3. Licensee is granted a non-transferable, non-exclusive license for the internal or external distribution of the SDK within the Bundled Products as restricted by Sections C (Conditions) and D (Distribution) below.

4. In general, for each license Licensee has acquired for the Product, one individual is authorized to use the Product according to the terms of this Agreement. Unless expressly stated otherwise, the Product may not be separated for use by more than the one individual authorized to use the Product. Specifically:

a. If Licensee is an individual, IMSI grants to Licensee as an individual a personal, nonexclusive license to make and use copies of the Product in accordance with the terms of this Agreement, provided that Licensee is the only individual using the Product.

b. If Licensee is an entity, IMSI grants to Licensee the right to designate one individual within Licensee’s organization to have the sole right to make and use copies of the Product in accordance with the terms of this Agreement.

5. The designated Primary contact named above is responsible for all distribution license reporting due to IMSI according to the terms of this agreement. The Primary contact named above can be changed without prior written notice to IMSI.

6. Licensee is granted the right to distribute only those component files specifically listed in the "REDIST.TXT" file, included in the SDK Components, as the ones designated for distribution.

C. CONDITIONS OF LICENSE

1. Licensee may not reverse engineer, decompile, disassemble or otherwise reduce the binary object code Components to a humanly perceivable form for any purposes whatsoever, in whole or in part, except and only to the extent that it is expressly permitted by applicable law notwithstanding this limitation.

2. Some of the TurboCAD and SDK components include technology that is licensed by IMSI from Lightwork Design, Limited ("Lightwork") and from Spatial Technologies, Inc. ("Spatial"), as indicated in the "REDIST.TXT" file. IMSI offers no rights for use or distribution of such technology beyond those rights granted by the TurboCAD End-User License Agreement. Licensee must apply for separate licenses from Lightwork and Spatial in order to obtain rights to distribute components that include technology of IMSI's licensors. The Lightwork technology provides high-end radiosity and ray-traced 3D rendering, and the Spatial technology provides a mathematically specified, topological 3D solid geometry model. It is possible to build 3D applications without these sub-licensed technologies: IMSI-only technology contained in the SDK uses OpenGL rendering and a native 3D solid geometry model that give developers a basic platform for manipulating 3D geometry and materials.

3. Licensee agrees that Licensee will treat the Components of the SDK and any Derivative Works with the same degree of care as Licensee accord to Licensee’s own confidential information, which Licensee exercises reasonable care to protect. Licensee’s obligations under this section with respect to particular Components of the SDK shall terminate when Licensee can document that:

a. The Components were in the public domain at or subsequent to the time they were communicated to Licensee by IMSI through no fault of Licensee’s;

b. The Derivative Works were developed by Licensee’s employees or agents independently of and without reference to any information communicated to Licensee by IMSI; or

c. The communication was in response to a valid order by a court or other governmental body, was otherwise required by law, or was necessary to establish the rights of either party under this Agreement.

4. Licensee agrees to protect IMSI's copyright and other ownership interests in all items in this SDK. Licensee agrees that all copies of items in this SDK reproduced for any reason by Licensee will contain the same copyright, trademark, and other proprietary notices as appropriate, as appear on or in the master items delivered by IMSI in this SDK. IMSI and/or its licensors retain title and ownership of the items in this SDK, the media on which it is recorded, and all subsequent copies, regardless of the form or media in or on which the original and other copies may exist. Except as stated herein, this Agreement does not grant Licensee any rights to patents, copyrights, trade secrets, trademarks or any other rights in respect to the items referred to by this Agreement.

5. Licensee agrees that any sale or distribution of products containing TurboCAD or SDK Components, or of products derived from them, shall carry with it a restriction that prohibits the purchaser or recipient from making any copies of the product. The sole exceptions will be copies required for backup purposes.

6. Licensee may not develop, integrate, market or resell products that use TurboCAD or SDK Components to become competitive with TurboCAD or the SDK. Competitive products may be defined as computer aided design ("CAD") or technical drawing products or products that CAD or technical drawing capability as part of their capabilities, that are intended for use by application developers or authoring product developers (in contrast to application users) to create applications with CAD or technical drawing capabilities. Products that offer an Application Programming Interface ("API") would typically be considered as belonging to this category.

7. Additionally, in order to avoid competitive situations where IMSI might compete with its own product, Licensee may not develop, integrate, market or resell environments that include the SDK in order to make the SDK's capabilities available to applications other than the Licensee’s Bundled Products. Relevant examples would be applications that perform as general purpose operating systems, general-purpose compilers or general-purpose plug-ins.

8. Licensee may not authorize Licensee’s customers or any third party to redistribute or sublicense the SDK or its copyrighted technology, except as specifically described within this Agreement. Reselling agreements for Licensee’s unmodified products (e.g. resellers and OEM's) are exempt from such restriction as long as proper license fees are paid.

9. Because IMSI distribution pricing is typically based on a per seat license fee, this Agreement, unless specifically noted herein, does not authorize Licensee to enter into unlimited distribution agreements with Licensee’s customers for use of the TurboCAD or SDK Components.

D. DISTRIBUTION AND PUBLICITY:

1. The TurboCAD and FloorPlan names are registered trademarks that are the sole and exclusive property of IMSI.

2. Licensee will acknowledge use of the SDK in the initialization screen or About Box and in online and printed documentation of any Bundled Products developed by Licensee, in a form similar to the following:

"CAD Technology copyrighted by International Microcomputer Software Corporation 1995-2001."

3. This License is specifically intended for use on individual client stations. It is not intended to cover any other usage, including, but not restricted to, server processing, concurrent processing, or unlimited use of any kind.

4. This License is limited to the distribution of the number of units of the SDK component named above. Additional distribution licenses are available at added cost.

5. Any direct or indirect distribution of any Bundled Products by Licensee shall be under the terms of an end user license agreement containing terms that:

a. Prohibit any modifications to the Derivative Works or any part thereof,

b. Prohibit any reverse engineering, disassembly or recompilation of the Derivative Works or any part thereof,

c. Disclaim any and all warranties on behalf of IMSI and each of its licensors,

d. Disclaim, to the extent permitted by applicable law, liability of IMSI and/or its licensors for any damages, whether direct, indirect, incidental or consequential, arising from the use of the Bundled Products,

e. Require the end user to comply fully with all relevant export laws and regulations of the United States to assure that the Bundled Products or any part thereof is not exported, directly or indirectly, in violation of United States law, and

f. Include the appropriate copyright notice.

5. IMSI may use Licensee’s name as a reference or in its advertising and publicity efforts.

E. UPDATES AND PRODUCT SUPPORT

1. Though SDK updates may be provided from time to time, unless agreed upon otherwise, they will be at added cost for either the SDK or for Distribution rights. Licensee understands that the purchase of SDK updates are separate from distribution license upgrades. Any license upgrades have to be purchased separately from SDK updates according to current price schedules. Upon purchase of an upgrade license, Licensee agrees to report the number of seats upgraded in addition to the number of new seats sold.

2. Licensee understands and agrees that IMSI may amend, modify, change, and cease distribution or production of TurboCAD or the SDK at any time. Licensee understands that Licensee is not entitled to receive any upgrades, updates, or future versions of the SDK under this Agreement.

F. REPORTING:

1. A distribution disclosure report plus appropriate licensing fees (if applicable) must be submitted to IMSI annually while any Bundled Products developed by the Licensee are shipping, or while any Bundled Products or Derivative Works are being used internally.

2. Reports are due no later than 30 (thirty) days after close of the current period, whether or not any license fees are due. If no seats have been used, it should be so noted.

3. If reports are more than 30 days late, access to technical support may be delayed until the report is received, in addition to other possible measures.

4. Reports not received for two consecutive reporting periods will be considered delinquent and will constitute a breach of this agreement. This agreement will terminate within 15 days of such delinquency, and Licensee will be obligated to cease and desist distributing Licensee’s product externally and internally, commercially and non-commercially with any IMSI Components.

G. US GOVERNMENT RESTRICTED RIGHTS

1. Use, duplication or disclosure by the United States Government is subject to restrictions as set forth under FARS 52.227-14, in FARS 52.227-19 or in DFARS 52.227-7013(c)(1)(ii) Commercial Computer Software - Restricted Rights.

H. ASSIGNMENT

1. This Agreement shall inure to the benefit of, and be binding upon, the parties hereto and their successors and legal heirs, but shall not be assignable by either party to any third party except with the prior written consent of the other party. Such consent will not be unreasonably withheld.

I. INDEMNIFICATION

1. Licensee agrees to indemnify, hold harmless, and defend IMSI from and against any claims or lawsuits, including attorneys' reasonable fees, that arise or result from the use or distribution of Bundled Products, provided that IMSI gives Licensee prompt written notice of any such claim, tenders to Licensee the defense or settlement of such a claim at Licensee’s expense and cooperates with Licensee, in defending or settling such claim.

J. TERM

1. This Agreement shall remain in effect until terminated. Licensee may terminate the Agreement at any time by ceasing to manufacture and distribute Derivative Works and Bundled Products of which the SDK is a component, and destroying all copies of the SDK Components.

2. The Agreement will also terminate upon Licensee’s failure to comply with the provisions of this Agreement, or in the event that Licensee becomes subject to any bankruptcy or insolvency proceeding under Federal or state statutes or becomes insolvent.

3. Upon any cause of termination, Licensee must cease to manufacture products of which the SDK is a component and must destroy all copies of the Product and all of its component parts.

4. Sections D.5 (Use of Licensee’s name) and H (Assignment) of this Agreement shall survive any termination. Upon termination of this Agreement, all fees or payments due IMSI by Licensee shall be immediately payable.

K. LIMITED WARRANTY

1. IMSI makes no warranty as to the operational performance of the SDK, the accuracy, completeness or usefulness of any information provided with this SDK, or the advisability of using the SDK in conducting Licensee’s business. The SDK is provided "as is" without warranty or representation, either express or implied, as to performance, merchantability or fitness for any particular purpose. The entire risk as to the quality and performance of the SDK is assumed by the licensee.

2. IMSI warrants that the diskettes/CD-ROM on which the Program is furnished will be free from defects in materials and workmanship under normal usage for a period of ninety (90) days from the date of original purchase. Licensee's sole and exclusive remedy in the event of a defect is expressly limited to the replacement of the diskettes/CD-ROM.

3. Because software is inherently complex and may not be completely free of errors, Licensee is advised to verify Licensee’s work and to make backup copies. In no event shall IMSI Software or anyone else who has been involved in the creation, production or delivery of this SDK be liable for any direct, indirect, special, incidental or consequential damages, such as, but not limited to, loss of anticipated profits, business interruption, benefits, use, or data resulting from the use of this SDK, or arising out of any breach of any warranty. Some states do not allow the exclusions or limitation of direct, incidental or consequential damages so the above limitation may not apply to Licensee.

L. CONSEQUENTIAL DAMAGES WAIVER

1. EXCEPT FOR A BREACH OF ANY LICENSE GRANT TO LICENSEE HEREUNDER OR UNDER THE AGREEMENT, IN NO EVENT SHALL EITHER PARTY BE LIABLE FOR ANY INDICENTAL, CONSEQUENTIAL, PUNITIVE OR SPECIAL DAMAGES, LOST PROFITS OR LOST DATA, OR ANY OTHER INDIRECT DAMAGES, EVEN IF SUCH PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.

M. ACCEPTANCE

1. I AGREE AND ACCEPT THE TERMS OF THIS LICENSE:

Signature: _____________________________________________________________

Date: ________________

Name (please print): ___________________________________________________


REDIST.TXT

The following tables list the files that can be redistributed under different SDK license agreements. Please see the notes at the end of the tables for more information. Any files not listed in this table are not permitted to be redistributed unless specifically included under a separate license agreement.

Table 1. File List with File Type and Additional License Requirements

File Name | File Type | Additional License
\Program\CADGX.exe | COMPILED SAMPLE |
\Program\converter.exe | COMPILED SAMPLE |
\Program\Draggers\GearContour.dll | COMPILED SAMPLE |
\Program\Draggers\inetool.dll | COMPILED SAMPLE |
\Program\Draggers\InsertExternalSymbol.dll | COMPILED SAMPLE |
\Program\Draggers\inssmobj.dll | COMPILED SAMPLE |
\Program\Draggers\instool.dll | COMPILED SAMPLE |
\Program\Draggers\JointPolyline.dll | COMPILED SAMPLE |
\Program\Draggers\PlaneBool.dll | COMPILED SAMPLE |
\Program\Draggers\planeparameters.dll | COMPILED SAMPLE |
\Program\Draggers\tcfile.dll | COMPILED SAMPLE |
\Program\Draggers\TCPssWiz.dll | COMPILED SAMPLE |
\Program\Draggers\ToolSurvCoord.dll | COMPILED SAMPLE |
\Program\Draggers\tooltextalong.dll | COMPILED SAMPLE |
\Program\Events.exe | COMPILED SAMPLE |
\Program\filters\Jpeg.dll | COMPILED SAMPLE |
\Program\filters\MSEExport.dll | COMPILED SAMPLE |
\Program\JpegLib.dll | COMPILED SAMPLE | IJG
\Program\LTSample.exe | COMPILED SAMPLE |
\Program\MakeDwg.exe | COMPILED SAMPLE |
\Program\matrix.exe | COMPILED SAMPLE |
\Program\palettes\CustomPalette.dll | COMPILED SAMPLE |
\Program\Preview.exe | COMPILED SAMPLE |
\Program\PrintCAD.dll | COMPILED SAMPLE |
\Program\Regens\Bolt3D.dll | COMPILED SAMPLE |
\Program\Regens\BoltNut.dll | COMPILED SAMPLE |
\Program\Regens\Cable.dll | COMPILED SAMPLE |
\Program\Regens\Conn.dll | COMPILED SAMPLE |
\Program\Regens\CoordText.dll | COMPILED SAMPLE |
\Program\Regens\DatumRef.dll | COMPILED SAMPLE |
\Program\Regens\DatumTarget.dll | COMPILED SAMPLE |
\Program\Regens\Gear.dll | COMPILED SAMPLE |
\Program\Regens\Hole.dll | COMPILED SAMPLE |
\Program\Regens\MfcSplin.dll | COMPILED SAMPLE |
\Program\Regens\Nut.dll | COMPILED SAMPLE |
\Program\Regens\Nut3D.dll | COMPILED SAMPLE |
\Program\Regens\Roundrect.dll | COMPILED SAMPLE |
\Program\Regens\Rrect.dll | COMPILED SAMPLE |
\Program\Regens\RRectA.dll | COMPILED SAMPLE |
\Program\Regens\Screw.dll | COMPILED SAMPLE |
\Program\Regens\SurvCoordReg.dll | COMPILED SAMPLE |
\Program\Regens\TextAlong.dll | COMPILED SAMPLE |
\Program\Regens\TextBox.dll | COMPILED SAMPLE |
\Program\Regens\texture.dll | COMPILED SAMPLE |
\Program\sampleprint.exe | COMPILED SAMPLE |
\Program\SDKDemo.ocx | COMPILED SAMPLE |
\Program\TCADX.exe | COMPILED SAMPLE |
\Program\TCView.exe | COMPILED SAMPLE |
\Program\TcViewer.ocx | COMPILED SAMPLE |
\Program\Ties\CurveTextTie.dll | COMPILED SAMPLE |
\Program\Ties\RadDiaDimTie.dll | COMPILED SAMPLE |
\Program\Ties\SurvCoordTie.dll | COMPILED SAMPLE |
\Program\Ties\VertexTie.dll | COMPILED SAMPLE |
\Program\viewpict.dll | COMPILED SAMPLE |
\Program\GXExt70.dll | SDK CORE LIBRARY |
\Program\GXMPS70.dll | SDK CORE LIBRARY |
\Program\GXRenders70.dll | SDK CORE LIBRARY |
\Program\GXSurf70.dll | SDK CORE LIBRARY |
\Program\GXTIES70.dll | SDK CORE LIBRARY |
\Program\gxutil70.dll | SDK CORE LIBRARY |
\Program\Imsigx70.dll | SDK CORE LIBRARY |
\Program\FrontLine.exe | TURBOCAD APPLICATION |
\Program\frontopt.exe | TURBOCAD APPLICATION |
\Program\Tcw70.exe | TURBOCAD APPLICATION |
\Program\Aboutbox.dll | TURBOCAD CORE LIBRARY |
\Program\COMProperties.dll | TURBOCAD CORE LIBRARY |
\Program\Dbapi70.dll | TURBOCAD CORE LIBRARY |
\Program\dbtieapi.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\ACISdr70.dll | TURBOCAD CORE LIBRARY | SPATIAL
\Program\Draggers\Arc1dr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Arc2dr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Asstdr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\BoolDr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Cadedr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\CamDrag.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\CopyPrs.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Dblldr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Dimsdr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Griddr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\LightDrag.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Linedr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Loft70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Measdr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Meetdr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Miscdr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Nodedr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\PickInside.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Pntdra70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Se3ddr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Shelling70.dll | TURBOCAD CORE LIBRARY | SPATIAL
\Program\Draggers\SnapTool.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\sobjinsert.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Soldr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Textdr70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\VbaTool.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Walker70.dll | TURBOCAD CORE LIBRARY |
\Program\Draggers\Wpldr70.dll | TURBOCAD CORE LIBRARY |
\Program\filters\Acflt70.dll | TURBOCAD CORE LIBRARY |
\Program\filters\Sat70.dll | TURBOCAD CORE LIBRARY | SPATIAL
\Program\filters\Tcwflt70.dll | TURBOCAD CORE LIBRARY |
\Program\Geom70.dll | TURBOCAD CORE LIBRARY |
\Program\IMSIctrl.dll | TURBOCAD CORE LIBRARY |
\Program\Mats.dll | TURBOCAD CORE LIBRARY | LIGHTWORK
\Program\MatsApi.dll | TURBOCAD CORE LIBRARY | LIGHTWORK
\Program\Mscrol70.dll | TURBOCAD CORE LIBRARY |
\Program\Numerics.dll | TURBOCAD CORE LIBRARY |
\Program\OrgChart70.dll | TURBOCAD CORE LIBRARY |
\Program\PageSetup.dll | TURBOCAD CORE LIBRARY |
\Program\palettes\CalcPal.dll | TURBOCAD CORE LIBRARY |
\Program\Proppg70.dll | TURBOCAD CORE LIBRARY |
\Program\RCIQA.dll | TURBOCAD CORE LIBRARY | LIGHTWORK
\Program\RCore70.dll | TURBOCAD CORE LIBRARY | LIGHTWORK
\Program\Regens\DoorHouse.dll | TURBOCAD CORE LIBRARY |
\Program\Regens\NorthDirection.dll | TURBOCAD CORE LIBRARY |
\Program\Regens\TcAcis70.dll | TURBOCAD CORE LIBRARY | SPATIAL
\Program\Regens\tcbrsh70.dll | TURBOCAD CORE LIBRARY |
\Program\Regens\TCCamera.dll | TURBOCAD CORE LIBRARY |
\Program\Regens\tccurv70.dll | TURBOCAD CORE LIBRARY |
\Program\Regens\tcdbl70.dll | TURBOCAD CORE LIBRARY |
\Program\Regens\tcdim70.dll | TURBOCAD CORE LIBRARY |
\Program\Regens\TCLight.dll | TURBOCAD CORE LIBRARY |
\Program\Regens\Tcmlin70.dll | TURBOCAD CORE LIBRARY |
\Program\Regens\Tcplln70.dll | TURBOCAD CORE LIBRARY |
\Program\Regens\tcpnt70.dll | TURBOCAD CORE LIBRARY |
\Program\Regens\Tcregion70.dll | TURBOCAD CORE LIBRARY |
\Program\Regens\Tcsphr70.dll | TURBOCAD CORE LIBRARY |
\Program\Regens\Tctext70.dll | TURBOCAD CORE LIBRARY |
\Program\Regens\Welding.dll | TURBOCAD CORE LIBRARY |
\Program\Regens\WindowHouse.dll | TURBOCAD CORE LIBRARY |
\Program\Renders\GlRender.dll | TURBOCAD CORE LIBRARY |
\Program\Renders\hiddenln.dll | TURBOCAD CORE LIBRARY |
\Program\Renders\lwRender.dll | TURBOCAD CORE LIBRARY | LIGHTWORK
\Program\Tc2Acis.dll | TURBOCAD CORE LIBRARY | SPATIAL
\Program\Tcapi70.dll | TURBOCAD CORE LIBRARY |
\Program\tcdb.dll | TURBOCAD CORE LIBRARY |
\Program\TCIntl70.dll | TURBOCAD CORE LIBRARY |
\Program\TcTools\PalTool.dll | TURBOCAD CORE LIBRARY |
\Program\tcwpro70.dll | TURBOCAD CORE LIBRARY |
\Program\Ties\ObjectTie.dll | TURBOCAD CORE LIBRARY |
\Program\Ties\SmartHatch.dll | TURBOCAD CORE LIBRARY |
\Program\Ties\ViewportTie.dll | TURBOCAD CORE LIBRARY |
\Program\vspell32.dll | TURBOCAD CORE LIBRARY | VCI
\Program\WebPubX.dll | TURBOCAD CORE LIBRARY |
\Program\Wintip70.dll | TURBOCAD CORE LIBRARY |
\Program\filters\3ds70.dll | TURBOCAD FILTER LIBRARY |
\Program\filters\bmpio70.dll | TURBOCAD FILTER LIBRARY |
\Program\filters\Dgn70.dll | TURBOCAD FILTER LIBRARY |
\Program\filters\Dwf70.dll | TURBOCAD FILTER LIBRARY |
\Program\filters\Ehpgl70.dll | TURBOCAD FILTER LIBRARY |
\Program\filters\Eps70.dll | TURBOCAD FILTER LIBRARY |
\Program\filters\Fcw70.dll | TURBOCAD FILTER LIBRARY |
\Program\filters\Flpln70.dll | TURBOCAD FILTER LIBRARY |
\Program\filters\jpgio70.dll | TURBOCAD FILTER LIBRARY |
\Program\filters\Shx70.dll | TURBOCAD FILTER LIBRARY |
\Program\filters\tc20io70.dll | TURBOCAD FILTER LIBRARY |
\Program\filters\Tcwflt70to60.dll | TURBOCAD FILTER LIBRARY |
\Program\filters\Vrml70.dll | TURBOCAD FILTER LIBRARY |
\Program\filters\wmfio70.dll | TURBOCAD FILTER LIBRARY |

Table 2. File Types Permitted to be Redistributed By License Type

License Type | File Types Permitted
END-USER LICENSE | COMPILED SAMPLE
BASIC DEVELOPER LICENSE | COMPILED SAMPLE TURBOCAD CORE LIBRARY SDK CORE LIBRARY
FILTER DEVELOPER LICENSE | COMPILED SAMPLE TURBOCAD CORE LIBRARY TURBOCAD FILTER LIBRARY SDK CORE LIBRARY

NOTES

1. Any file types not listed in Table 2 above require separate agreements in order to be redistributed.

2. Any file with additional license requirements indicated in Table 1 ("SPATIAL", "LIGHTWORK", etc.) must also be covered by separate agreements, or comply with licensor's open source requirements, in order to be redistributed. Contact IMSI for further information.


TurboCAD SDK Overview

The TurboCAD SDK offers you a wide range of development choices to develop CAD and general-purpose graphics solutions. The SDK offers you the ability to exploit the 2D and 3D capabilities of TurboCAD through a simple programming interface, whether you're an individual TurboCAD user who wants to automate specific tasks within TurboCAD, or a developer who wants to build and sell third-party plug-ins.

You can program the TurboCAD SDK using the Visual Basic for Applications development environment that ships with every copy of TurboCAD Professional, or with any other popular software development package that supports Microsoft's COM (Common Object Model) programming interfaces.

The SDK provides direct, object-oriented access to over 50 different objects that allow you to manipulate drawings and their contents, extract data and rendered bitmaps, and integrate CAD data with other systems. This overview will give you a brief idea of some of the ways you can use the SDK, as well as where to turn for more information.


Documentation Roadmap

The complete documentation for the TurboCAD SDK is broken into sections. Each section focuses on a particular area of knowledge, and provides a particular aspect of learning or using the SDK.

TurboCAD SDK Overview

This section contains a broad summary of the types of projects you can build with the SDK, gives a quick example of how to get started using Visual Basic for Applications, and provides references for sources of more information.

Exploring the TurboCAD SDK In Depth

This section covers the TurboCAD object model extensively, for the Visual Basic for Applications programmer. Each object is explained and many examples of using the objects for common tasks are given. For each example, whenever possible, the analog in the the TurboCAD user interface is provided.

Building Advanced Projects with the SDK

Note: This section will be added soon.

Some objects in the TurboCAD SDK cannot be used directly from Visual Basic for Applications, but require a third-party development environment such as Visual Basic or Visual C++. This section explains how to build add-ins and other projects that require external compilers.

Example Projects

This section describes the sample code projects that are shipped with the SDK, and provides brief instructions of how to build and install them.

TurboCAD Object Reference

This section is comprised of syntax, notes, and code samples for every object, method, property, event, and constant exposed by the TurboCAD SDK.

In addition to the Table of Contents that list each section, the documentation is indexed, and both the website version and HtmlHelp application versions of the documentation provide full text search.


Building Solutions with the TurboCAD SDK

TurboCAD integrates Microsoft Visual Basic For Applications (VBA), COM, and OLE Automation to allow developers create custom projects to automate creation of CAD drawings, automate repetitive tasks, analyze CAD drawings, and import or export CAD data to any COM compliant application, such as those in the Microsoft Office family.

There are several ways to develop custom solutions using the TurboCAD SDK:

  • By operating within TurboCAD itself, by creating VBA macros in TurboCAD's VBA environment, or by writing script for HTML pages that can be run in TurboCAD's Internet Palette.
  • By running TurboCAD from an external application by referencing TurboCAD's object model, using either the VBA provided by that application, or using any development environment that supports binding to COM Automation servers (such as Windows Scripting Host, Internet Explorer's JScript, Visual Basic, or other products). You can launch the TurboCAD application and control it externally, or you can reuse the TurboCAD engine (.DLLs) and embed TurboCAD's functionality inside the external application.
  • By building new tools and add-ins to extend TurboCAD's functionality, using an external development environment that permits building COM server .DLL's (such as Visual Basic, Visual C++, or Delphi).


Writing VBA Macros

Generally speaking VBA macro is the fastest and simplest (hence, the most popular) tool to develop custom solutions in TurboCAD. It's an integrated development environment allowing you to work simultaneously with both TurboCAD objects and VBA code.

Since VBA IDE has its own debugger developer can control creation of TurboCAD objects, their properties, behavior, etc. If any property or value needs modifying it can be done on-the-fly. It's also the easiest and quickest way to get familiar with TurboCAD's objects hierarchy.

VBA macros are stored as VBA project files with the .TCM file extension and can be reused in other TurboCAD projects. As an example of using VBA, you can create a macro to draw a floor plan using data from an Excel spreadsheet and vice versa, or you can create office room layout using numeric and descriptive data stored in an MS Access database.

Although VBA provides an extremely powerful and easy to use platform on which you can build significant solutions, you should be aware of a few limitations:

  • VBA code is interpreted each time you run a macro. Therefore the performance of your VBA project might be slower than desired, especially when you deal with complex objects and large calculations. By using compiled languages such as C++ you may be able to obtain better performance.
  • VBA macro projects (.TCM files) are always attached to a particular TurboCAD drawing and cannot be run from the Windows shell or command line without first loading the drawing. Using Visual Basic or another application shell can give you access to TurboCAD objects without requiring a predefined drawing.
  • VBA macro projects (.TCM files) tend to grow in size depending on the complexity of your TurboCAD project. Eventually you might end up with a rather large macro project file that might become even bigger than the TurboCAD drawing (.TCW file) you design your solution for.


A Simple VBA Example: Title Block

TurboCAD SDK allows developer to customize creation of any CAD drawing by adding objects to a drawing, creating custom properties for the objects, automatically specifying paper formats, drawing layouts, etc. Using TurboCAD SDK developers can automate routine tasks such as adding frames and title boxes with drawing description, project name, author name, etc. to a drawing.

For instance, you need to create a technical drawing with certain standard formatting that includes paper size, frame, title block, drawing data (scaling, author's name, etc.) Of course it is possible to draw all the above objects (rectangles, lines, text) in TurboCAD itself, yet if you need to reproduce the same formatting again and again in new drawings, this approach is clearly ineffective and time-consuming. A better way for such repetitive tasks would be to create a macro that can be added to a TurboCAD drawing whenever this particular formatting is needed.

In this example you will add an already written VBA project (TCM file) to a new drawing. The VBA project contains a macro that adds a frame with a simple title block to the drawing. You can obtain the TCM file for the TitleBlock project here. It can also be found in the Example Projects section of the documentation.

Adding a Macro Contained in an Existing VBA Project

Here are the steps required to create the new drawing, load the VBA project, and run the macro:

Open a new TurboCAD drawing by selecting New, New From Scratch from the File menu.

Open the Macros dialog box by selecting VBA Macro, Macros from the Tools menu.

Replace the default project scope name (Project1) with a meaningful name for your macro project. We'll use the name TitleBlock. Type this name in the edit box on the Macros dialog box.

NOTE You can add as many macro projects to your drawing as needed, and each project can contain any number of individual macros. Each project and its contained macros is saved as one TCM file. After you have entered a new name for your macro project the Add... and New buttons become active.

Press the Add... button to add the TitleBlock project to the drawing.

In the File Open dialog box locate the VBA project file for this sample, named TitleBlock.TCM.

NOTE You can find all the SDK macro samples in the SDK\Macros directory. Click OK to attach the file as the TitleBlock VBA project. You should see the names of the available macros in the project, with the macro SetTitleBlock highlighted, as shown in this figure:

Press the Run button.

A frame with a simple title box in the right bottom corner will be added to your drawing, as shown in the accompanying figure.

Creating a New VBA Project

Creating a new VBA project is just as simple:

Type the name for your new macro project in the edit box of the Macros dialog box.

Press the New button to add the new project to the drawing.

Press the Editor button to start writing your macros.


Examining Title Block VBA Macro Sample Code

To see the code used in the VBA TitleBlock sample project, press the Editor button on the VBA Macro dialog, or select VBA, Visual Basic Editor from the Tools menu. This launches the VBA Editor application, which should appear on your desktop looking something like this:

Reference or copy help for VBE here

To see the macro code that draws the title block, scroll through the editor window. You should see the code listed as shown below:

Attribute VB_Name = "modTitleBlock"
Option Explicit

Sub SetTitleBlock()

'Code in this listing does several things:
'First, we get a reference to the active drawing object, then we set its
'drawing mode to Paper Space (Paper Space and Model Space will be discussed
'in Chapter 5), then we define paper size, calculate and draw border
'rectangle within defined paper space and margins, then draw the title box
'within the border rectangle (as a table), and then fill two cells of the
'title box table with simple text: "Design By" and "Project".

'Set up error handler
  On Error GoTo SetTitleBlock_Err

'Declare and set major TurboCAD objects
  Dim ActDr As Drawing
  Dim Grs As Graphics
  Dim Gr As Graphic
  Dim Vi As View

'Get active drawing object
  Set ActDr = ActiveDrawing

'Set active drawing space: Paper Space = 0, Model Space = 1
  ActDr.Properties("TileMode") = 0

'Get graphics collection of the active drawing
  Set Grs = ActDr.Graphics

'Set measurement units for the current drawing space to inches
  ActDr.Properties("PaperLinearUnitName") = "in"

'Declare variables to hold paper size data
  Dim PSetUp As PageSetup
  Dim SpaceUnits$, UnitScale#
  Dim PaperWidth#, PaperHeight#

'Read property (we set it to inches ealier in the code)
    SpaceUnits = ActDr.Properties("PaperLinearUnitName")

'Read paper size properties (we don't need to do that, it's just an illustration)
    Set PSetUp = ActDr.PageSetup
    PaperWidth = PSetUp.SheetWidth
    PaperHeight = PSetUp.SheetHeight

'Set paper size
    PaperWidth = 12#
    PaperHeight = 10#

'Define scaling rate depending on measurement units specified by user
'(in our case we programmtically set 'PaperLinearUnitName' to inches –
'see code above).We need to convert user measurement units to millimiters
'(TurboCAD's internal measurement units)
    If SpaceUnits = "mm" Then UnitScale = 1
    If SpaceUnits = "cm" Then UnitScale = 10
    If SpaceUnits = "m" Then UnitScale = 100
    If SpaceUnits = "in" Or SpaceUnits = """" Then UnitScale = 25.4
    If SpaceUnits = "ft" Or SpaceUnits = "'" Then UnitScale = 25.4 * 12

    PSetUp.SheetWidth = PaperWidth * UnitScale
    PSetUp.SheetHeight = PaperHeight * UnitScale

'Calculate rectangle for the frame based on defined paper size including margins
  Dim LeftMargin#, RightMargin#, TopMargin#, BottomMargin#
  Dim xLeft#, xRight#, yBottom#, yTop#
    LeftMargin = 1
    RightMargin = 0.5
    TopMargin = 0.5
    BottomMargin = 0.5

    xLeft = LeftMargin
    xRight = PaperWidth - RightMargin
    yBottom = BottomMargin
    yTop = PaperHeight - TopMargin

'Draw frame
    Set Gr = Grs.Add(imsiPolyline)
    With Gr.Vertices
        .Add xLeft, yBottom, 0
        .Add xRight, yBottom, 0
        .Add xRight, yTop, 0
        .Add xLeft, yTop, 0
        .AddClose
    End With
    Gr.Properties("PenWidth") = 0.01
    Gr.Draw

'Draw Title Box (as a table)
  Dim GrTable As Graphic
  Dim hTable#, wTable#
  Dim xL#, xR#, yB#, yT#, xMid#, yMid#

    hTable = 1
    wTable = 6

    xL = xRight - wTable
    xR = xL + wTable
    yB = yBottom
    yT = yB + hTable
    xMid = (xL + xR) / 2
    yMid = (yB + yT) / 2

    Set GrTable = Grs.Add(imsiPolyline)
    With GrTable.Vertices
        .Add xL, yB, 0
        .Add xR, yB, 0
        .Add xR, yT, 0
        .Add xL, yT, 0
        .Add xL, yB, 0
        .Add xL, yMid, 0, False
        .Add xR, yMid, 0
        .Add xMid, yB, 0, False
        .Add xMid, yT, 0
    End With
    GrTable.Properties("PenWidth") = 0.01
    GrTable.Draw

'Add text to table
  Dim GrText As Graphic
  Dim InputString$

    InputString = "Design By"
    Set GrText = Grs.AddText(InputString, (xL + xMid) / 2, yT, 0, hTable / 2, , , , 2)
    InputString = "Project"
    Set GrText = Grs.AddText(InputString, (xMid + xR) / 2, yT, 0, hTable / 2, , , , 2)

'Get actiev view of the active drawing…
  Set Vi = ActDr.Views(0)
'… and fit drawing to screen
  Vi.ZoomToExtents

SetTitleBlock_Exit:

'Destroy TurboCAD objects
    Set ActDr = Nothing
    Set Grs = Nothing
    Set PSetUp = Nothing
    Set Gr = Nothing
    Set GrTable = Nothing
    Set GrText = Nothing
    Set Vi = Nothing

    Exit Sub

SetTitleBlock_Err:
    If Err.Number <> 0 Then
       MsgBox "Error " & Err.Number & " in Sub 'SetTitleBlock'" & _
       vbLf & vbLf & Err.Description
       Resume SetTitleBlock_Exit
    End If
End Sub

This VBA code does several things: first, we get a reference to the active drawing object, then we set its drawing mode to Paper Space (Paper Space and Model Space are described in the In Depth section), then we define paper size, calculate and draw border rectangle within defined paper space and margins, then draw the title box within the border rectangle (as a table), and then fill two cells of the title box table with simple text: "Design By" and "Project".


Using Scripts in TurboCAD's Internet Palette

Besides using VBA to add enhancements to TurboCAD when its running, you can use the scripting capabilities of TurboCAD's Internet Palette. The Internet Palette allows developers to include VBScript and JavaScript to automate tasks as well as use other Internet-specific features in their solutions.

To use the Internet Palette in your custom TurboCAD solutions you must have Microsoft Internet Explorer installed on your computer. Internet Explorer provides a free development environment that gives you access to all of TurboCAD's objects in the context of a web page, with browsing, scripting, and HTML debugging capabilities. The VBScript engine in Internet Explorer uses a syntax very similar to that of Visual Basic for Applications.

Link to IE scripting pages


Creating A Standalone Application

TurboCAD SDK is most typically used by a third party developer who wants to build a custom application that relies on the TurboCAD SDK's ability to load and view files and manipulate graphic data. The client can be written as a standalone application, a Java applet or component, or as an ActiveX control (OCX).

TurboCAD engine can be used in your application either in Local Server mode or in Inproc Server mode.

In Local Server mode TurboCAD runs as a full-blown application which makes available all TurboCAD interface (UI) and tools.

Local server sample link

Inproc Server mode exposes all TurboCAD mechanisms to load and display graphical files, render graphics, create graphical objects, etc. However TurboCAD engine does not provide objects to build user interface for your application. You will have to create your own program interface to manipulate TurboCAD objects and call its functions and tools.

Inproc server sample link

Inproc Server mode is most typically used to create ActiveX controls utilizing TurboCAD engine's functionality.

ActiveX sample link


Writing Custom Add-Ins

The TurboCAD SDK provides specialized program interfaces (APIs) to implement specific add-ins: custom objects, custom tools, custom file filters, custom ties, and custom palettes. These add-ins can let you build solutions that go beyond the capabilities of the standard TurboCAD engine. Here are some examples of the types of problems that can be solved with TurboCAD add-ins:

  • If you want to design parametrically controlled graphic objects, similar to those that come with TurboCAD, such as the Wall object, you can create a custom object (Regen).
  • If you have external data that you want to read into TurboCAD and display graphically, you can create your own custom file filter to do the job.
  • If you have a specific task you want to automate, you can create custom Tools that harness the power of TurboCAD's graphic engine, and integrate fully with the TurboCAD user interface.
  • If you need to maintain a specific link or relation between unrelated objects (such as associative dimensions), you can create a custom tie.
  • If you want to build a special user interface that needs its own window area, you can create a custom palette, that arranges your user interface in a docked window alongside TurboCAD's other palettes.

Add-Ins are OLE Automation servers, where the TurboCAD application (or the TurboCAD in-process server engine) is the client. An Add-In server creates one or more automation objects, through the standard COM creation system. Each automation object must support a standard suite of methods and properties, necessary to support the functionality they provide.

See the TurboCAD Add-Ins API reference (Chapter 3) for a complete description of this interface.

Add-In extensions are loaded when TurboCAD starts up. To be successfully loaded, an Add-In extension file (a module with a .DLL, .EXE., or .VBP extension) must be located in the Regens (Draggers , Filters, Ties, Palettes) subdirectory of the server. Each module in this directory is queried for a type library (or an alternative method for Delphi) that tells TurboCAD what extensions are served by the module. Then the module's automation object(s) are created.

On initialization, the Add-In server tells TurboCAD information on itself depending on the Add-In type. Later, TurboCAD will call on the Add-In server to perform certain actions depending on the Add-In type (see various custom Add-Ins later in this section). For instance, TurboCAD will ask the Custom Object Add-In server to "regen" (regenerate) its graphics when they have been modified by users. This regeneration process allows the Custom Object to maintain its graphics using its own logic.


Creating Custom Objects

In a nutshell, custom object is means of parameterization of typical elements of a drawing. By custom object we understand an external description of an object and its properties that are read by TurboCAD and transformed into graphical on-screen representation. Suppose we have a description of coil spring that formally is described by the following parameters: number of active coils, spring diameter, wire diameter, pitch, etc. Using this formal description we can create both 2D and 3D images whose actual on-screen representation will vary each time we change one or more parameters in this description.

Typically Custom Object is a DLL placed into Regens folder and loaded as TurboCAD loads at startup. However you can design, test, and debug your Custom Object using integrated development environment provided by TurboCAD SDK all in VBA, and when you're finally statisfied with the results, you can create a DLL project using VB 6.0 by copying most your VBA code into VB 6.0 DLL project.

The same result (Custom Object functionality) can be achieved by writing a VBA macro directly in a TurboCAD drawing, yet in this case each time you change the object's properties you need to remove previously created object, create a new one and position it to specific coordinates in a drawing whereas custom object preserves its coordinates in a drawing. Besides VBA approach results in attaching to a drawing a whole set of VBA macros for each object where we need parameterization flexibility.


Creating Custom Tools

If custom object is a means of an object parameterization then Custom Tools is a means of an object creation and analysis.

For instance, TurboCAD user interface provides a button to create a circle, yet it has no button to let you create and display a custom object you designed. Custom Tool is conceived to provide this functionality: it may include buttons to create a Custom Object, other user interface elements, data input fields, local menus etc.

It is also possible to use Custom Tools to analyze, modify, and manipulate already created objects. For instance, Custom Tools can be used to calculate objects areas, volumes of selected 3D objects, Boolean operations on objects, etc (see sample in section 1.1.2).

Again it is possible to do the same using VBA macros right in a TurboCAD drawing, yet in this case you need to deal with the issues described in 1.2.3.1.


Creating Custom Filters

Custom Filter provides means to exchange data between applications. Filters are extension objects that TurboCAD uses to read graphic information from disk into the current drawing, or to save the current drawing to disk.

TurboCAD SDK provides several ways to implement data exchange between applications: VBA macros, custom objects, custom tools. However the most common way to arrange data exchange between applications would be to create a custom file filter.

For instance, you need to read data from a file that is not included in file types natively understood by TurboCAD, i.e. this file type is not shown among available file types in the File Open dialog box. In other words, TurboCAD does not support this type of file (for instance, using TurboCAD's File à Open menu you cannot open text files, Excel spreadsheets, CSV files, etc.).

Imagine you have a text file containing coordinates of a number of points comprising a geometrical figure. What you'd like to do is read this data into TurboCAD and have TurboCAD draw this geometrical figure for you in a TurboCAD drawing. This is a typical custom file filter task. You need to write a procedure to read textual data from a file and create corresponding geometry in a TurboCAD drawing according to certain algorithm.

A custom file filter will be added to the list of file types understood by TurboCAD in File Open, Files Save, and File Save As dialog boxes depending on the filter type (data export or import).

There are two major ways to implement a Custom File Filter: through OLE Automation (by opening host application to read a file created in that application) or through byte-by-byte reading of data from the file. Same approaches can be used to create custom file filters for saving TurboCAD drawings as file types not native to TurboCAD (.TXT, .CSV, .XLS, etc.).


Creating Custom Ties

Like Custom Object a Custom Tie is means to create a parameterized object. By 'tie' we understand some user-defined graphical relationship assigned to one or more intrinsic TurboCAD object.

Example: you have two lines drawn in a TurboCAD project. We can programmatically assign to both lines a certain relationship, e.g. coincidence and perpendicularity ties between the lines. This means that we if modify one of the lines the other one will respond according to pre-defined relationship (tie). In this example the angle between the lines will always be 90 degrees.

Custom Tie between objects is not only a geometrical relationship - by tie we understand any relationship between TurboCAD objects when modifying one object causes user-defined changes (geometry, properties) in other, 'tied' objects.


Creating Custom Palettes

Custom Palette is very similar to Custom Tool, i.e. it provides similar functionality. The difference between the two: a Custom Tool is a button on TurboCAD toolbar whereas a Custom Palette has its own window (a docking palette similar to standard TurboCAD palettes) with its own UI. Besides Custom Palette uses a simplified program interface to connect to TurboCAD engine.


Other TurboCAD SDK and VBA Programming Resources

Other places you can obtain information on VBA programming in general, and on TurboCAD SDK programming in particular, include the following:

TurboCAD Professional v7 and VBA Forum

One of the public TurboCAD discussion forums, this is the moderated discussion group for all questions related to TurboCAD programming. You can also read or contribute to the TurboCAD for Windows : SDK Forum (C++, VB, Delphi and Java) Forum, if your focus is on programming with these external compilers, although this forum is not actively maintained at present.

TurboCAD SDK Programmers Gallery

This is a proposed area for third party developers to share source code and compiled projects. Send us any submissions you'd like to see posted.

TurboCAD SDK Support Pages

This will be a site or sites containing a FAQ and other up-to-the-minute pages. For now, just try tcsdkbeta@imsisoft.com.

Older documentation can be found here.

Microsoft VBA Pages

Microsoft provides a wealth of information about VBA for developers and endusers on their website.

Microsoft Scripting Technologies Pages

Here you can find information on JScript, VBScript and Windows Script Host that can also be used to build web pages that interface with the TurboCAD SDK.

Books on VBA

Here is a short list of recommended reading, with links to Amazon.com, if the listed books are available for purchase. Fatbrain.com is another good online supplier of computer books.

VB and VBA in a Nutshell: The Languages
By Paul Lomax, Ron Petrusha (Editor), ISBN 1565923588

Developing Solutions With Office 2000 Components and VBA
By Peter G. Aitken, ISBN 0130263052

Of course, we welcome your recommendations. Please let us know if you have found any books, websites or other sources especially useful.


Exploring the SDK in Depth

This section provides an exploration of all the objects exposed in the SDK that you can use to create programs using Visual Basic for Applications. Each object is introduced and examples of solutions that can be built with the object are presented, followed by a survey of the detailed operations that the object supports.


Understanding the TurboCAD Object Model

An object is the main building block of the TurboCAD interface. Each exposed object represents a certain part of TurboCAD engine and can be programmatically accessed and manipulated to control its behavior. Objects are combined into collections. There are many different types of objects in the TurboCAD interface. For example:

  • All on-screen geometry is implemented through use of Graphic object
  • Organizational structures such as layers and blocks are objects
  • Drawing display is represented by View object and Views collection
  • The drawing itself and the TurboCAD application are objects

To create macros in TurboCAD VBA or to build applications or servers that use the TurboCAD engine, you need to write programming statements that tell the engine what you want to do. The functionality in the TurboCAD engine that you control is exposed by programmable objects, composed and organized in a hierarchical object model.

Before you can begin building macros and other programs with the TurboCAD SDK, it's important to understand the variety of objects within the TurboCAD object model, and the common ways you can perform basic tasks using these objects. The objects are structured in a hierarchical fashion, with the Application object at the root. The view of this hierarchical structure is referred to as the Object Model. The Object Model shows you which object provides access to the next level of objects.

This diagram gives an indication of the hierarchical organization of the model:

Application object
Filters collection (Filter object)
NamedColors collection (NamedColor object)
Properties collection (Property object)
RegenMethods collection (RegenMethod object)
Renders collection (Render object)
TieMethods collection (TieMethod object)
Tools collection (Tool object)
Drawings collection (Drawing object)

Graphic object
Block object
BoundingBox object
BrushStyle object
LineStyle object
Matrix object
Properties collection (Property object)
Vertices collection (Vertex object)
Graphics collection (Graphic object)

Object
Collection

Blocks collection (Block object)
Graphics collection (Graphic object)
BrushStyles collection (BrushStyle object)
BrushPatterns collection (BrushPattern object)
GraphicSets collection (GraphicSet object)

Layers collection (Layer object)

LineStyles collection (LineStyle object)
Macros collection (Macro object)

NamedViews collection (NamedView object)
PaperSpaces collection (PaperSpace object)
Graphics collection (Graphic object)
Properties collection (Property object)
Properties collection (Property object)

TieSets collection (TieSet object)
Ties collection (Tie object)
Views collection (View object)

Graphics collection (Graphic object)

Objects within the model are interrelated. These relationships of access and containment are illustrated in the diagram by lines connecting the object type names. Some objects, called collections, hold groups of child objects, establishing a hierarchy; access to the child objects is often controlled by the parent collection. All collections in the object model expose standard ways of adding, removing, and accessing child objects.

Each object you work with is an instance of an object type. An object type exposes properties, which represent the modifiable state of an object; and methods, which are procedures that you can use to create new objects, destroy existing objects, or change an object's state. The largest part of the documentation of the TurboCAD SDK will explain in detail what these types, methods and properties are.

After discussing the basics of how you start using the objects contained in the TurboCAD object model, the documentation text will explain commonalities that are shared between different types in the object model, and how to navigate along the lines of the object model hierarchy. Other sections of the documentation will help you learn about specific properties and methods that you can use on the most important object types. The reference section of the documentation explains in detail the syntax and behavior of all the objects, methods and properties in the model.


Referencing the TurboCAD Type Library

The description of TurboCAD's objects, methods, and properties are packaged in a machine-readable file called a type library, embedded within the DLLs distributed with the TurboCAD SDK. The location of this type library is registered within the Windows Registry when you install TurboCAD or the TurboCAD SDK. The type library explains to programming development systems such as Microsoft Visual Basic, Microsoft Visual Basic for Applications, and Java the proper syntax for building machine code that uses TurboCAD objects. Before you can begin to use TurboCAD objects, you must establish a "reference" to the TurboCAD type library within the development system you are using. The process for creating this reference varies from one system to another.

Visual Basic and Visual Basic for Applications

If you're using VBA within TurboCAD, this reference is already established for you. If you're programming in Visual Basic or using another application's VBA to access the TurboCAD engine, you must explicitly add the reference. To add the TurboCAD type library:

  • Start the Visual Basic Editor.
  • Open the References dialog box using the Tools, References... menu item.
  • Check the TurboCAD v4.1 Programmable Objects item in the Available References list box, as shown in the figure.
  • Press the OK button to confirm the reference.

Visual C++

If you're using Microsoft Visual C++, you can make a reference to TurboCAD by using the #import statement in your header files. The type library is contained in IMSIGX70.DLL, so a typical project will contain a statement like:

#import "C:\Program Files\IMSI\TCWP71\Program\IMSIGX70.DLL" raw_interfaces_only, raw_native_types, no_namespace, named_guids

After importing the type library, you can use Visual C++'s smart pointers to access the TurboCAD SDK's objects and interfaces. See the Visual C++ documentation for more details.


Using TurboCAD Objects in Visual Basic and Visual Basic for Applications

Once the TurboCAD type library has been referenced you can begin using the objects in the TurboCAD SDK. The following discussion is limited to Visual Basic and VBA; for other development systems, consult their documentation. TurboCAD objects are contained within a namespace defined by the name of the type library ("IMSIGX"), in order to prevent confusion between similarly named objects defined by different applications. VB and VBA allow you to use this namespace optionally, as long as the names for TurboCAD's objects don't conflict with those contained in other type libraries referenced in your VB/VBA project.

Browsing TurboCAD Objects

You can see the list of available TurboCAD objects by opening the VB/VBA Object Browser.

explain procedure

If you choose "IMSIGX" as the name in the Library combo box, the Object Browser will list only the TurboCAD objects and constants in the Object pane. The Browser will look something like this:

insert figure here

Declaring A TurboCAD Object Variable

You can also use the IMSIGX namespace to limit Visual Basic's Intellisense feature to show you possible object types when you are typing in the Visual Basic code editor. To use the TurboCAD Application object, for example, you can declare a variable as a TurboCAD object type by writing code such as the following:

Dim app As IMSIGX.Application

Try typing this statement in the editor, and notice that when you finish typing "IMSIGX.", Intellisense will pop up a list of TurboCAD objects, and allow you to select one to complete the word. The entire statement declares the variable named app as a TurboCAD Application object type. Note that we have "qualified" the Application object type by the use of TurboCAD's library name: IMSIGX. Of course you can omit the IMSIGX qualifier and achieve the same result. Try typing this:

Dim app As Application

In either case, you have declared the variable to be able to hold a reference to the TurboCAD Application object.

Obtaining and Setting Object Variable References

Now you're ready to actually use the Application variable you have declared. This is accomplished by using the Visual Basic Set statement. There are a number of ways to obtain object references. Here is one way:

Set app = Application

The TurboCAD SDK exposes a number of global methods and properties. The Application global property returns a reference to the currently running Application object. Note that you must use the Set statement to assign references to object variables; otherwise Visual Basic will report a run-time error.

Set app = New Application

This is the standard way to create new objects. If you were working in Visual Basic, this statement would result in the launch of a new instance of the TurboCAD application. You use the New statement with the name of a creatable object type. Not all objects can be created this way. In the documentation, you will see occasions where objects are referred to as "standalone". In most cases these standalone objects can be created from scratch using the New statement.

Set app = CreateObject(, "TurboCAD.Application")

This statement has the same effect as the previous one. The CreateObject Visual Basic function also allows you to specify the server on which TurboCAD will be launched. Consult the Visual Basic documentation to find out more about using this function.

Set app = GetObject(, "TurboCAD.Application")

This Set statement assigns a reference to the currently running instance of TurboCAD, by using the GetObject function. Once you have an Application object, you can obtain references to other objects in the object model.

Dim dwg As Drawing
Set dwg = app.ActiveDrawing

In this case you are using the ActiveDrawing property on the Application object to obtain a reference to a Drawing object. Since the ActiveDrawing property is also a global property (as are many of the properties exposed by the Application object), you could have also written:

Set dwg = ActiveDrawing

to accomplish the same thing. Many of the examples contained in the documentation will make use of the ActiveDrawing global property.


Using TurboCAD Objects and Other Type Library Objects

Because of the optional nature of the IMSIGX namespace when using TurboCAD VBA, you can write either of the two statements

Dim app As IMSIGX.Application

or

Dim app As Application

to declare a TurboCAD Application object variable. However, declaring a bare, unqualified Application object variable in another VBA application, such as Microsoft Excel, will cause VBA to use that application's type library, not TurboCAD's.

Insert example of using Excel object


Using TurboCAD Objects and Collections

Once you have declared a variable that can hold a TurboCAD object, and assigned an object to the variable using the Set statement, you can use the properties and methods that the object exposes.

Using Object Properties

Dim bVisible As Boolean
bVisible = app.Visible
app.Visible = Not bVisible

With this bit of code, you can access and modify the Visible property of the Application object stored in the variable named app. Note that because the Visible property is not an object type, but a built-in Visual Basic type (Boolean), you don't need to use the Set statement to assign its value.

Using Object Methods

In addition to getting and setting the values of properties, objects expose methods that perform operations. You use the same type of syntax as with properties. For example, to quit the running application:

app.Quit

Methods can return values:

Dim filename As String
filename = app.GetOpenFileName

Using the With Statement and Objects

The performance and readability of a block of code that accesses an object's methods and properties can be enhanced when you use the Visual Basic With and End With statements. Inside the block of code defined by these statements, you can omit the variable name and refer to the object's methods and properties with an abbrieviated syntax:

With ActiveDrawing
       Debug.Print "Drawing " & .Name & " has " & .Graphics.Count & " graphics"
       Debug.Print "Drawing " & .Name & " has " & .Graphics.Count & " graphics"
End With

Most of the code samples you will find in the SDK use the With statement.

The Default Method or Property

Some object types have a default method or property that allows you to shortcut some of the normal syntax. For example, TurboCAD collections expose an Item method that lets you select an object from the containing collection. Because Item is the default method for the Properties collection, either of the following two statements is equivalent:

Dim prop As Property
Set prop = app.Properties.Item(0)
Dim prop As Property
Dim prop As Property
Set prop = app.Properties(0)

Another place you can use this shortcut is the Property object's (default) Value property. To find out what the Value of a Property object is, either of these bits of code is equivalent:

Dim val As Variant
Set prop = app.Properties.Item("UndoBuffers")
val = prop.Value
Dim val As Variant
Dim val As Variant
Set prop = app.Properties("UndoBuffers")
val = prop

Choosing which syntax to use is just a matter of style.


Objects and Collections

Many of the object types in TurboCAD's object model are collections. Collections are just a special kind of object type that are used as containers for other objects. The objects are held in the collection in the form of a numbered, indexed list. You can walk through this list to find all the objects in the collection, or retrieve a particular object based on its numbered index. In addition most collections support retrieving objects based on a name, as well as an index number.

In the object model diagram collections are indicated by a light blue color. These types expose standard properties and methods to enumerate and access objects contained in the collection.


Performing Common Operations on Collection Objects

Since collection objects are commonly used to move through the object model, there are standard methods and properties provided by all collection types.

Finding Out How Many Items Are in a Collection

You use the Count readonly property of a collection to find out how many items the collection contains:

Dim c As Long
c = app.Properties.Count

Selecting an Item in a Collection by Index

Items in a TurboCAD collection are indexed, starting from zero for the first item in the collection. The last item in the collection has an index value one less than the number obtained from the collection's Count property. You use the (default) Item method of a collection to select an indexed item. For example, to list all the items in a collection, you can write code such as the following:

Dim i As Long
For i = 0 to  c - 1
    Debug.Print app.Properties.Item(i).Name
    'or Debug.Print app.Properties(i).Name
Next

Selecting an Item in a Collection by Name

Most items contained in TurboCAD collections have a Name property that identifies the item. In these cases, you can also pass the name of the item you want to select as the argument to the collection's Item method:

Set prop = app.Properties.Item("UndoBuffers")
'or Set prop = app.Properties("UndoBuffers")
Debug.Print prop.Name 'prints "UndoBuffers"

Using the For Each…In Statement to Enumerate All of a Collection's Contents

Visual Basic's For Each…In Statement allows to you to enumerate all the items in a collection, setting the reference to the item each time the loop is entered:

For Each prop In app.Properties
Debug.Print prop.Name
Next

Adding an Item to a Collection (Creating a New Item)

Most collections support adding or removing items. Each collection usually has a method named Add that allows you to add an item. Some collections maintain complete ownership over the items they contain. In these cases, the Add method actually creates the item, and then adds it to the collection. The parameters for each of these collection's Add method will vary according to the information necessary to create the collection's contained item type. The Add method that creates a new item will usually return a reference to the newly created and added item, ready for your use.

Set dwg = app.Drawings.Add("NewDrawing")

Adding an Existing Item to a Collection

Some collections allow you to add items that exist outside the collection. In this case, the Add method (or a method with a name that begins with "Add") will take a reference to the existing item as a parameter, and will have no return value. If you want the collection to have complete ownership of the item, you should release the outside reference to the item after you add it, by setting the variable to the empty reference "Nothing".

Set gr = New Graphic 'create a standalone graphic
ActiveDrawing.Graphics.AddGraphic(gr) 'now part of Graphics collection
Set gr = Nothing 'release outside reference

Removing an Item from a Collection (Deleting the Item)

For collections that completely control the existence of their contents, the standard way to remove an item from the collection is to obtain the item, and then call the item's Delete method (for some item types, such as the Drawing object, this method might have another name, such as Close). This will destroy the item and remove it from the collection:

c = app.Drawings.Count 'current size of collection
If c > 0 Then
  Set dwg = app.Drawings(0) 'obtain the item
  dwg.Close 'delete the object
  Set dwg = Nothing 'the dwg variable is now useless
  c = app.Drawings.Count 'now it's one less than before the Close!
End If

Removing an Item from a Collection (Retaking Ownership)

In cases where collections don't completely control the lifetime of their contents, you can remove an item from the collection and let it survive outside the collection by using the collection's Remove method. This takes the same parameters as the Item method, and returns the newly liberated item:

c = ActiveDrawing.Graphics.Count 'current size of collection
If c > 0 Then
  Set gr = ActiveDrawing.Graphics.Remove(c - 1) 'obtain the last item
  'gr is now free from the collection, we can use it or release it
  Set gr = Nothing 'released and destroyed!
  c = ActiveDrawing.Graphics.Count 'now it's one less than before the Close!
End If


Navigating through the Object Hierarchy

If you look at the object model diagram, you will see lines connecting the names of the object and collection types. These lines represent the paths by which you can move up and down the hierarchy of containment. For example, the Application object contains a collection called Drawings, which you obtain by accessing the Application's Drawings property. Then, to locate a particular Drawing within the Application, you can use the Drawings collection's standard Item property, supplying either an integral argument (representing the numbered index, starting with zero, within the collection), or a String argument (representing the name of the Drawing):

Dim app As Application
Dim dwgs As Drawings
Dim dwg As Drawing
Set app = Application
Set dwgs = app.Drawings
Set dwg = dwgs(0)
Set dwg = dwgs("Drawing1")

This is an example of traversing down the object hierarchy. Most object types support the standard Parent and Application properties for traversing up the hierarchy also:

Set app = dwg.Application
Set app = dwg.Parent

By referring to the object model diagram, you can discover the most common methods of accessing one type of object given another.


Understanding Standard, Extended, and Custom Object Properties

While all object types expose built-in, browseable properties for the use of the programmer, some TurboCAD objects (the Application, Drawing, and Graphic objects) also have properties that are not visible to the Visual Basic Object Browser, because they are not encoded in the TurboCAD type library. Since TurboCAD is a dynamic, extensible system, these properties may differ from one release or installation to the next. These properties are accessed through a special collection type, appropriately enough, Properties, and can be discovered and used at run-time, as will be discussed in the following sections.

To distinguish between these two different systems of property use, we will use the term "standard" to mean the browseable unvarying properties that are encoded in the TurboCAD type library, and the term "extended" to refer to those properties that are accessed by use of the Properties collection.

Because CAD drawings often need to associate additional data with particular elements contained within them, TurboCAD allows you to create your own extended properties and attach them to TurboCAD's Graphic objects. We will use the term "custom" property to refer to an extended property that is supplied by the application programmer, and is not part of the TurboCAD system.


Using Standard Properties

Standard properties can be discovered by using the Object Browser, or by the Intellisense feature built into the Visual Basic Editor.

Insert figure here

If you open the Object Browser and select a TurboCAD object in the object pane, you will see the names of the object's standard properties listed in the property pane (indicated by the property icon). Clicking on a property name causes the type and help string associated with the property to be listed in the information pane below.

When you type the object name and a dot in the Visual Basic Editor, Intellisense will pop up a list of the object's methods and standard properties, allowing you to complete the expression by pressing the Tab key. Standard properties are the easiest to access, but are limited to the most commonly used properties of an object. Since TurboCAD is an extensible system, the SDK provides a mechanism for adding more properties to an object: Extended and Custom properties.


Extended and Custom Properties: Using the Properties Collection

To access the extended and custom properties for an object, you must use the Properties object exposed by the object. Since the Properties object is a true collection, you can use standard ways to find and locate individual properties, such as the Visual Basic For Each..In statement.

Dim props As Properties
Dim prop As Property
Set props = app.Properties
For Each prop in props
    Debug.Print prop.Name
Next

If you know the name of the extended or custom property you can access it through the Properties collection's (default) Item property:

Set prop = app.Properties.Item("AutoSave")

or, equivalently, using the fact that Item is the default property for the Properties collection:

Set prop = app.Properties("AutoSave")


Using the Property Object

The objects contained in the Properties collection are Property objects. Each extended or custom Property object has a Name, Type, and Value standard property exposed. You can query both extended and custom properties for these:

Debug.Print "The name of the AutoSave property is " & prop.Name
Debug.Print "The type of the AutoSave property is " & prop.Type
Debug.Print "The current value of the AutoSave property is " & prop.Value

The Name and Type of extended and custom properties are always read-only. The Value may or may not be changed, depending on the individual property. The values returned in a Property object's Type property are the same as those returned by Visual Basic's VarType function. Some properties are stored as array types, and require special handling.

See the modProperties.bas sample module for recommended ways to discover Property object information.

NOTE Although an extended property may be attached to an object, it is possible that the property may be undefined. In this case, the Type and Value properties of the Property object will return errors. Make sure to include error handling code when dealing with extended properties.


The Application Object

Application object is the root of TurboCAD object model. By creating an object variable pointing to TurboCAD Application object you initialize TurboCAD engine to do some work for you. You can create new or open existing drawings, create and modify graphical objects in TurboCAD drawings, read and set objects' properties, etc.

For instance, setting a reference to an active drawing using the Application object's ActiveDrawing property is the easiest way to manipulate an open drawing programmatically since a VBA macro is always executed in an active drawing. For details on using Drawing object's properties and methods see The Drawing Object section.

Many of the Application's methods and properties are also exposed as global methods and properties, so you don't always need to specify the Application object or declare an Application variable to use them. In addition, the Application property (both a global property and a property of the Application object itself) allows you to get an immediate reference to the Application:

Debug.Print Application.Drawings.Count

There are actually two kinds of Application object: one of them is responsible for creation of TurboCAD application, i.e. it starts TurboCAD as self-standing application (out-of-process server), while the other is responsible for creation of TurboCAD as in-process server. To learn more about using the different flavors of Application for standalone projects that use TurboCAD either as an in-process or out-of-process server, see the Advanced Topics section of the documentation.


What's in an Application?

The Application object exposes as number of properties and methods that allow to access and manipulate behavior of TurboCAD engine. The below list shows the most typically used properties and methods of the Application object:

Application Standard Properties
Property | Description
ActiveDrawing | Returns the active Drawing object, i.e. a currently opened TurboCAD drawing.
Application | Returns a self-reference to the object. Since this is exposed as a global property, you can use this property to get a reference to the currently running application instance in VBA, without using New, CreateObject, or GetObject.
Build | Read-Only. Returns the TurboCAD application build number as a string.
Drawings | Returns the Application object's Drawings collection, i.e. all currently opened TurboCAD drawings including the active drawing.
Filters | Returns the Application object's Filters collection, i.e. the collection of Filter objects.
Name | Read-Only. Returns the name of the TurboCAD Application object as string.
NamedColors | Returns the Application object's NamedColors collection, i.e. the collection of NamedColor objects.
Path | Read-Only. Returns a string containing complete path to the folder where TurboCAD executables are installed (without the final separator), e.g. 'C:\Program Files\IMSI\TCWP70\Program'.
Properties | Returns the Application object's Extended Properties collection (see below).
RegenMethods | Returns the Application object's RegenMethods collection.
TieMethods | Returns the Application object's TieMethods collection.
Renders | Returns the Application object's Renders collection.
Selection | Returns the Selection collection of the active Drawing object, i.e. all currently selected graphic objects.
SnapModes | Returns and sets active Snap Modes.
Visible | Returns or sets TurboCAD application Visible property. TRUE if the application's main window is visible.

Application Extended Properties
Property | Description
UndoBuffers | Specifies the maximum number of user actions to be saved in Undo buffer to enable user undo as many last actions as specified by this number.
PaperColor | Specifies color of the paper sheet in paper Space Mode.
BackgroundColor | Specifies TurboCAD workspace color in Paper Space mode.
ZoomFactor | Allows to increase/decrease current project zoom. Same as pressing Zoom button on the toolbar.
PromptForSummaryInfo | Specifies whether to prompt user for project summary info when saving a TurboCAD project file.
AutoSaveOption | Turns on and off TurboCAD AutoSave feature. If set to TRUE (AutoSave on) then open project will be saved every X minutes, where X is the AutoSave property setting (see below).
AutoSave | Specifies time interval in minutes for the AutoSave feature (works in combination with AutoSaveOption property when AutoSaveOption property is set to TRUE).
GeometricExtents | Specifies selection mode for individual graphics in a drawing: 0 - whole object must be within selection, 1 = selecting any part of an object selects the whole object.
SnapMode | Defines mouse click behavior, i.e. sets a certain relationship between mouse click and an object in a drawing.
Aperture | Specifies area around mouse click (in pixels) where nearest object is sought.
$DEFAULTFONT | Sets default font for text in TurboCAD drawings.

The Application object exposes methods that allow you to perform application-scope activities (tasks that don't require a drawing, or that are persistent from one TurboCAD session to the next):

Application Methods
Method | Description
GetOpenFilename | Displays a standard Windows Open File dialog box without actually opening any file. Returns full path and name of selected file(s) as string.
GetSaveAsFilename | Displays standard Windows Save As dialog box without actually saving any files. Returns a filename entered by user as string.
Quit | Quits the application. Does not run any OnClose macros before exiting.
ConnectEvents | Connects TurboCAD Application object events sink. Set the mask parameter to only receive a subset of the full event set.
DisconnectEvents | Disconnects an ApplicationEvents object sink.

The Application object in out-of-process server mode fires events at predetermined times. You can write subroutines, called event handlers, that receive notification when these events are fired, allowing you to perform tasks when users interact with TurboCAD. Below is the list of the most typically used events fired by the TurboCAD Application object:

Application Events
Event | Description
BeforeExit | This event is fired before the Application object is destroyed.
DrawingNew | This event is fired after a new Drawing object has been created.
DrawingOpen | This event is fired after an existing Drawing object, i.e. drawing file, has been opened.
DrawingActivate | This event is fired when a drawing receives the focus and becomes the active window.
DrawingDeactivate | This event is fired when a drawing loses focus.
DrawingBeforeClose | This event is fired before a Drawing object is closed.
DrawingBeforeSave | This event is fired before a Drawing object is saved.
DrawingAfterSave | This event is fired after a Drawing object has been saved.
MouseDown | This event is fired when a mouse button is pressed.
MouseUp | This event is fired when a mouse button is released.
MouseMove | This event is fired when mouse is moved.
BeforeDoubleClick | This event is fired when left mouse button is double clicked yet prior to any TurboCAD processing of this event.
BeforeRightClick | This event is fired when left mouse button is double clicked yet prior to any TurboCAD processing of this event.
SelectionChange | This event is fired when selection changes, i.e. when user selects or deselects an object.
RunTool | This event is fired when a Tool object is activated, i.e. when a tool is selected in TurboCAD toolbar.
Drop | This event is fired after some object has been dropped into a drawing.


Accessing the Application Object

If you develop a project using TurboCAD Visual Basic for Applications you don't have to create the Application object: it exists implicitly in all TurboCAD projects. You can access its standard properties and methods using the global Application property:

Debug.Print Application.Name

or set up a variable to hold the application, if you're going to use many Application methods or properties in a subroutine:

Dim app As Application
Set app = Application

See the Advanced Projects section of the documentation for more information on creating or obtaining a reference to an existing TurboCAD Application object only when you design an external custom application.


Destroying the Application Object

If you want to write a macro that shuts down the active instance of TurboCAD, you can use the Application object's Quit method. After calling this method, any variables holding a reference to the application, and the global Application property should be considered invalid, and you should not use any more TurboCAD objects from this point on.

If you're writing standalone applications that use TurboCAD as an in-process or out-of-process server, consult the Advanced Projects section for information on how to destroy or detach from the TurboCAD Application object.


Getting the Application Name

Name is the default, readonly property of the Application object.

Debug.Print Application.Name

or

Debug.Print Application

will print "TurboCAD(tm) for Windows" in the VBA Immediate window.

By using the Name property and Windows API you can locate the TurboCAD application window.

Example code, please?


Showing and Hiding the Application

The Application object's Visible property can be used to show or hide all of TurboCAD's windows and palettes. To show the windows, set the property to True; to hide them, set the property to False:

'Hide TurboCAD from view
Application.Visible = False
'Is TurboCAD visible?
Debug.Print "Visible? " & Application.Visible


Getting the Active Drawing

The Application object's ActiveDrawing property returns the currently active Drawing object, i.e. the drawing whose window has the current focus:

Dim dwg As Drawing
Set dwg = Application.ActiveDrawing

See the Drawing object documentation for more information.


Getting the Current Selection

The Application object's Selection readonly property returns the Selection collection of the active Drawing object, i.e. all currently selected graphic objects.

The following example prints IDs and types of all currently selected graphic objects to the Immediate Window:

Dim gr As Graphic
Debug.Print "Selection contents:"
For Each gr In Application.Selection
     Debug.Print "ID: " & gr.ID & ", Type: " & gr.Type
Next

See the section on Collections of Graphics for more information on using the Selection collection.


Changing Active Snap Modes

Snap modes enable you to control how TurboCAD responds to mouse actions when you are drawing or editing. Some modes are mutually exclusive; others can be used in combination. This provides you with an enormous number of possible techniques, but the fundamental principles underlying all the modes are consistent and relatively simple. Once you understand these principles, you will be able to exploit them to find efficient and precise methods of drawing and editing.

There are two major categories of snap modes:

1. Snap modes, which determine where exactly TurboCAD defines a point when you click the mouse in the drawing area.

2. Coordinate system modes, which determine how you can use mathematical coordinates to specify the location of any point on the drawing.

The SnapModes property determines how mouse click coordinates are transformed to coordinates of a specific point in a TurboCAD drawing. For instance, if you set SnapModes property to 4 (imsiSnapGrid), all mouse clicks will be interpreted as occurring in the nearest grid intersection. For more details on Snap Modes in TurboCAD refer to TurboCAD Help.

This SnapModes property setting can be any combination of the following values (ImsiSnapMode Enum):

Snap Modes
Snap Mode | Value | Description
imsiSnapOff | 1 | No additional calculations are performed upon mouse click
imsiSnapOrtho | 2 |
imsiSnapGrid | 4 | Mouse click is treated as if it happened in the nearest grid point
imsiSnapNearestPoint | 8 | Mouse click is treated as if it happened in the nearest vertex of the nearest graphics object
imsiSnapIntersection | 16 | Mouse click is treated as if it happened in the nearest intersection of closest graphics objects
imsiSnapMidpoint | 32 | Mouse click is treated as if it happened in the middle of the nearest line segment
imsiSnapCenter | 64 | Mouse click is treated as if it happened in the nearest vertex of the nearest arc object
imsiSnapQuadrant | 128 |
imsiSnapEntity | 256 | Mouse click is treated as if it happened in the nearest point of the nearest graphics object
imsiSnapProjection | 512 |
imsiSnapMirror | 1024 |
imsiSnapRelocate | 2048 |

The following example sets the Application object's SnapModes property to Grid (numeric value = 4):

Application.SnapModes = imsiSnapGrid

imsiSnapGrid mode is not applicable when you use TurboCAD engine as in-process server, due to internal TurboCAD functioning.

what about Application.Properties("SnapMode")?


Using Application Extended Properties

The Properties readonly property returns the Application object's Properties collection (see the documentation on standard and extended properties for more information). Many of the Application object's extended properties can be used to change a variety of application-wide settings. For a full list of Application properties refer to the TurboCAD Visual Basic Reference.

This example shows how to modify the UndoBuffers property using Properties collection:

Application.Properties("UndoBuffers") = 99


Setting the Undo Capacity

To change the amount of memory that TurboCAD uses for remembering undoable actions, you use the Application UndoBuffers extended property. A larger value assigned to UndoBuffers will consume more memory, but will allow more actions to be undone. The value for UndoBuffers can't be zero. If you try setting this property to zero TurboCAD will reset it to 1.

It is not recommended to assign UndoBuffers value greater than default (100). Theoretically you can assign any valid integer value for this property, yet you have to bear in mind that while user is working on a drawing each new action is saved to Undo buffer reducing physical computer memory and slowing down overall performance. Eventually an unreasonable UndoBuffers setting may even result in a system crash if all available memory is used up by Undo buffer. On the contrary setting UndoBuffers property to a value lesser than default may improve performance.

Example of setting the UndoBuffers property:

Application.Properties("UndoBuffers") = 10


Turning the AutoSave Feature On or Off

Sometimes when you're working on large or complex projects you might want to turn Auto Save feature off to improve performance. You can turn the AutoSaveOption off programmatically by using the Application object's AutoSaveOption extended property.

Application.Properties ("AutoSaveOption") = False


Changing the Display Color for Paper

You can control the color displayed for the paper areas in your drawing windows, by setting the Application object's PaperColor extended property. You can use any long integer that represents a valid color. You can also specify a color by using the RGB function with red, green, and blue color components. The value of each color component is an integer that ranges from zero to 255. For example, you can set PaperColor to green as the integer value 4966415 or as red, green, and blue color components 15, 200, 75:

Application.Properties("PaperColor") = 4966415
Application.Properties("PaperColor")= RGB(15, 200, 75)

For more information on colors, see the section on NamedColor objects.


Changing the Display Color for the Background

You can control the color displayed for the areas around the paper in your drawing windows, by setting the Application object's BackgroundColor extended property. You can use any long integer that represents a valid color. You can also specify a color by using the RGB function with red, green, and blue color components. The value of each color component is an integer that ranges from zero to 255. For example, you can set BackgroundColor to green as the integer value 4966415 or as red, green, and blue color components 15, 200, 75:

Application.Properties("BackgroundColor") = 4966415
Application.Properties("BackgroundColor")= RGB(15, 200, 75)

For more information on colors, see the section on NamedColor objects.


Displaying a "File Open" Dialog

You can use the Application object's GetOpenFilename method to display a dialog that lets a user choose a file to open in TurboCAD. GetOpenFilename has the following syntax:

Application.GetOpenFilename ([Filter], [Title], [ButtonText], [MultiSelect])

All parameters of the GetOpenFileName method are optional. Meaning of each parameter is given in the table below:

Part | Description
Filter | Optional, Sting. A three-character file extension, e.g. "DWG" by which the files are filtered in the dialog box. By default the list of files contains all filters registered in TurboCAD. Non-functional in current release, reserved for future implementation.
Title | Optional, String. Sets dialog box title.
ButtonText | Optional, String. Non-functional in current release, reserved for future implementation.
MultiSelect | Optional, Boolean. Specifies if user can select more than one file in the Open File dialog box. Default: False. Non-functional in current release, reserved for future implementation.


Displaying a "File Save" Dialog

You can use the Application object's GetSaveAsFilename method to display a dialog that lets a user choose a file name to save in TurboCAD. The GetSaveAsFilename method has the following syntax:

Application.GetSaveAsFileName ([Filter], [Title], [ButtonText], [MultiSelect])

All parameters of the GetSaveAsFilename method are optional. Meaning of each parameter is given in the table below:

Part | Description
Filter | Optional, Sting. A three-character file extension, e.g. "DWG" by which the files are filtered in the dialog box. By default the list of files contains all filters registered in TurboCAD. Non-functional in current release, reserved for future implementation.
Title | Optional, String. Sets dialog box title.
ButtonText | Optional, String. Non-functional in current release, reserved for future implementation.
MultiSelect | Optional, Boolean. Specifies if user can select more than one file in the Open File dialog box. Default: False. Non-functional in current release, reserved for future implementation.

For example, the following line of code will open Save As dialog box with "MyFile" as file name and "MySaveAsDialog" as title:

strSaveFileName = Application.GetSaveAsFilename ("MyFile",,"MySaveAsDialog")

After pressing OK in the dialog box user will assign full path to strSaveFileName variable.


Using Other Application Properties and Methods

For information on other properties, see the following sections:

"Modifying the Application Environment"

"Using Events"

"TurboCAD Visual Basic Reference"

"Advanced Projects"


The Drawing Object

The Drawing object represents a TurboCAD drawing and is a member of the global and Application Drawings collections.

The Drawing object is a container for all the graphic and style data that is stored in a TurboCAD file. This data is organized in a series of collections that are read-only properties of the Drawing object.

Block, BrushStyle, Layer, and LineStyle objects can also be accessed through Graphic object (see details in TurboCAD Graphics). However, these objects cannot be created using Graphic object since Graphic object can only work with existing objects. To create new Block, BrushStyle, Layer, and LineStyle objects you must access a respective collection though the Drawing object.


What's in a Drawing?

Drawing object has nearly four hundred properties, in this section we discuss only those properties that manipulate Drawing object as a whole. There are also Drawing properties that apply to graphic objects within a Drawing object; these will be discussed in detail in section 5.1, Specifics of various TurboCAD 's graphics. This section focuses on the most commonly used properties and methods of the Drawing Object. The list of those properties and methods is given below.

Drawing Standard Properties
Property | Description
Name | Returns full path and name of the Drawing object.
Path | Returns full path to the drawing object, same as Name.
Saved | Returns or sets Saved property of the Drawing object.
Properties | Returns the Drawing object's Properties collection.
Layers | Returns the Drawing object's Layers collection.
Blocks | Returns the Drawing object's Blocks collection.
Views | Returns the Drawing object's Views collection.
NamedViews | Returns the Drawing object's NamedViews collection.
ActiveView | Returns the Drawing object's ActiveView object.
TieSets | Returns the Drawing object's TieSets collection.
UCS | Returns or sets the Drawing UCS (User Coordinate System) as Matrix object.
Graphics | Returns the Drawing object's Graphics collection.
Selection | Returns the Drawing object's Selection object.
GraphicSets | Returns the Drawing object's GraphicSets collection.
BrushStyles | Returns the Drawing object's BrushStyles collection.
LineStyles | Returns the Drawing object's LineStyles collection.

Drawing Extended Properties
Property | Description
LinearUnitName | Get/set the name of currently used measurement units for Model Space (in, m, mm, etc.).
LinearUnitSystem | Get/set measurement system for Model Space (1 - English, 2 - Metric).
PaperLinearUnitName | Get/set the name of currently used measurement units for Paper Space (in, m, mm, etc.).
PaperLinearUnitName2 | Get/set the name of currently used measurement units for text in Paper Space (in, m, mm, pt, etc.).
PaperLinearUnitName3 | Get/set the name of currently used measurement units for line width in Paper Space (in, m, mm, pt, etc.).
PaperScale | Get/set the scaling for Paper Space (1:2, 1:3, etc.).
PaperScaleSystem | Get/set the scaling system for Paper Space.
TileMode | Get/set current drawing mode, i.e. Paper Space or Model Space.
$PLUNITS | Get/set measurement system for Paper Space (1 - English, 2 - Metric).
$SCALE | Get/set the scaling for Model Space (1:2, 1:3, etc.).
$SCALESYS | Get/set the scaling system for Model Space.

Drawing Methods
Method | Description
Activate | Makes the specified Drawing object the active Drawing object.
Close | Closes the Drawing object.
Save | Saves the whole specified drawing to a disk file even if no changes have been made to the drawing since last save.
SaveAs | Saves the entire drawing to a different file.
SaveCopyAs | Saves drawing to a specified file name and path, yet does not change the file name and path of currently open drawing file like SaveAs method does.
SelectAll | Selects all Graphic objects in the Drawing object's Graphics collection. Has the same effect as Drawing.Graphics.Select method.
UnselectAll | Unselects all of the Graphic objects in the Drawing object's Graphics collection. Has the same effect as Drawing.Graphics.Unselect or Drawing.Selection.Unselect.


Working with Drawings

In TurboCAD you can work with more than one drawing at a time. The Application Object's Drawings collection owns and maintains the access to the currently open drawings. You can open existing drawings or create new drawings using the Drawings collection's Open and Add methods. You can also access and modify all open drawings in your current TurboCAD session.


Opening an Existing Drawing

To open a previously saved TurboCAD drawing use the Open method is the method of the Drawings collection of the Application object.

You can open an existing drawing file using instruction similar to the one below (supply your actual path and file name):

Dim dwg As Drawing
Set dwg = app.Drawings.Open("C:\Program Files\IMSI\TCWP70\Drawings\Drawing1.tcw")

If you're working within TurboCAD VBA environment the Application object exists implicitly so you may omit it, since the Drawings collection is exposed as a global property. You could also write:

Dim dwg As Drawing
Set dwg = Drawings.Open("C:\Program Files\IMSI\TCWP70\Drawings\Drawing1.tcw")

to open the drawing.


Creating a New Drawing

New drawings are created from scratch by using the Add method of the Drawings collection of the Application, or the global Drawings property. When you create a new drawing from scratch, you can supply a name that will be shown in the window caption:

'create a new drawing from scratch
Dim dwg As Drawing
Set dwg = app.Drawings.Add("MyNewDrawingName")


Accessing the Active Drawing

In TurboCAD the active drawing is any drawing that has the focus. The active drawing notion makes sense only when you programmatically manipulate TurboCAD using the Visual Basic for Applications environment, or when TurboCAD engine runs as out-of-process server. For information on using drawings for in-process server applications, see the Advanced Projects section of the documentation.

Normally when you open or create a drawing, it becomes the active drawing.

To gain an access to the currently active drawing use the Application object's or the global ActiveDrawing property:

Dim dwg As Drawing
Set dwg = ActiveDrawing
'you could also use:
Set dwg = app.ActiveDrawing
MsgBox "The currently active drawing is " & dwg.Name

should we also add support for a ThisDrawing object in VBA?


Saving a Drawing

The Drawing object exposes three methods allowing to save a TurboCAD drawing to a disk file: Save, SaveAs, and SaveCopyAs. Specifics of using each method are discussed in this section.

Using the Save Method

The Save method saves the whole specified drawing to a disk file even if no changes have been made to the drawing since last save.

You cannot use Save method to save new drawings, use SaveAs method instead. If the Save method is applied to a new drawing, i.e. a drawing not yet saved to a disk file, the method will fail with an error.

should we change this behavior if you supply the correct path?

Here's an example of opening and saving a drawing:

Dim dwg as Drawing
Set dwg = Drawings.Open("C:\Program Files\IMSI\TCWP70\Drawings\Drawing1.tcw")
' . . . do something with the drawing
dwg.Save

Using the SaveAs Method

To save a previously unsaved drawing, or to save an existing drawing to a different disk file use the SaveAs method of the Drawing object:

Dim dwg As Drawing
Set dwg = ActiveDrawing
dwg.SaveAs "C:\My Documents\Projects\NewDrawingFile.TCW"

After saving, the file name and path will be updated in the drawing window to point to the new settings.

The path to the folder specified in the SaveAs method must exist, or the SaveAs method will fail with an error.

The SaveAs method does not check if the specified file name exists. If a file with the specified name does exist in the specified directory, it will be overwritten by the SaveAs method.

Using the SaveCopyAs Method

The SaveCopyAs method saves drawing to a specified file name and path, yet unlike the SaveAs method does not change the file name and path of currently open drawing file. Example:

Dim dwg As Drawing
Set dwg = ActiveDrawing
dwg.SaveCopyAs "C:\My Documents\Projects\DrawingFileCopy.TCW"

The SaveCopyAs method does not check if the specified file name exists. If a file with the specified name does exist in the specified directory, it will be overwritten by the SaveCopyAs method.


Closing a Drawing

You can close an open drawing by executing the Drawing object's Close method.

If you have created a Drawing object and assigned it to an object variable, and then closed the drawing, the memory that TurboCAD uses for the Drawing object has not been released, and the reference in the object variable cannot be used anymore (since the drawing doesn't exist). Good programming style recommends to release the object variable memory by immediately releasing the now unusable variable reference, using Visual Basic's Nothing keyword:

Sub CloseDrawingExample()
Dim dwg As Drawing
'Display full name of the open drawing
'Get total number of currently open drawings
'Close drawing object without prompting for save
    dwg.Close False
'Immediately release reference to closed drawing
    Set dwg = Nothing
'Get total number of currently open drawings
'to make sure it decreased by 1
    MsgBox "Total drawings = " & Drawings.Count
End Sub


Closing All Drawings in an Application

To close all open drawings, use the CloseAll method of the global or Application object Drawings collection:

'close all the drawings in the Application
app.Drawings.CloseAll


Making a Drawing the Active Drawing

You can use the use the Activate method to activate a specified Drawing, i.e. make it the ActiveDrawing object:

'make the first drawing the active one
app.Drawings(0).Activate


Getting the Drawing's Name

The Drawing object's default, readonly Name property returns the name of the currently active drawing as a String. For example, the ?ActiveDrawing instruction executed in TurboCAD VBA Editor's Immediate Window will return something like

Drawing1 (for a new drawing, not yet saved to disk; and something like

C:\Program Files\IMSI\TCWP70\Drawings\Drawing1.tcw for an existing drawing or a drawing already saved to disk.


Getting the Drawing's File Name

You use the Path property to find out the file name of the last Save or SaveAs operation:

Need example


Finding Out If Changes Have Been Made to a Drawing

The Saved property of the Drawing object is True if no changes have been made to the Drawing object since it was last saved.

When you open a new blank drawing in TurboCAD its Saved property is False. If you have programmatically created a TurboCAD Application object it opens a new blank drawing with Saved property set to False. In this case you may want to set the drawing's Saved property to True (without actually saving the drawing) before closing TurboCAD Application object (using Application.Quit method) to avoid being prompted to save an open drawing, for example:

ActiveDrawing.Saved = True

To actually save an open drawing use the Drawing object's Save method (see Using Drawing Methods, Save).


Setting up Drawing Units

Before you work with a new drawing, it's important to set the correct unit system. Usually you'll want to add objects to a uniformly scaled workspace, called Model Space. Two extended properties allow you to control the unit settings for Model Space: LinearUnitSystem and LinearUnitName.

LinearUnitSystem

This Drawing extended property controls the measurement system for Model Space. The default setting for the Model Space measurement system depends on your locale. To change the LinearUnitSystem property setting assign it an Integer with the following allowed values:

1: English System

2: Metric System

For example:

'Set model space measurement unit system to Metric
ActiveDrawing.Properties("LinearUnitSystem") = 2

LinearUnitName

This Drawing property returns a String containing the name of the current measurement units, e.g. "in" for inches, "mm" for millimeters. The default setting for the LinearUnitName property is "in". To change the LinearUnitName property setting assign it a String with the name of the specified measurement units:

'Set measurement unit name to millimeters
ActiveDrawing.Properties("LinearUnitName") = "mm"

The LinearUnitName setting must correspond to the LinearUnitSystem setting, i.e. if you set LinearUnitSystem to 1 (English) you should use English measurement units. Theoretically it is possible to specify measurement unit name conflicting with the measurement unit system, yet it might cause unpredictable results.

other model space settings

A drawing also contains at least one Paper Space, a workspace that is used to hold Graphics that will be printed on a scale determined by the sheet to be printed. The Drawing object has a set of analogous properties that allow you to set the units and size of the paper. These paper space properties are discussed in the section "Working with Model Space and Paper Space"


Changing the Drawing's Coordinate System

Returns or sets the Drawing UCS (User Coordinate System) as Matrix object. Read-Write. (See details on representing Coordinate System as matrix and working with matrix in section 5.3, TurboCAD Inside).

Syntax

Object.UCS where Object must be a valid Drawing object.

Example

Dim MyTCApp as New TurboCAD.Application
Dim MyDwg As Drawing, MyUCS As EMatrix
Set MyDwg = MyTCApp.ActiveDrawing
Set MyUCS = MyDwg.UCS


Using Other Drawing Properties and Methods

See the following sections for more information:

"Graphic Appearance" for the use of the BrushStyle and LineStyle objects stored in Drawing collections.

"Collections of Graphics" for the use of Graphics, Selection, Layer, Block and GraphicSet objects as collections for graphics

"The View Object" for information on a Drawing's ActiveView, and the collections of Views and NamedViews owned by a Drawing.

"Working with Model Space and Paper Space" for information on how Graphics can be scaled differently on individual sheets.

"Advanced Projects" for information on TieSets

"TurboCAD Visual Basic Reference" on all drawing properties and methods


TurboCAD Graphics: Subtypes, Hierarchy, Geometry and Appearance

To do anything useful with the TurboCAD SDK, you will interact with TurboCAD's Graphic object type. In order to know how you can best work with the TurboCAD library, it is important to understand the basic concepts of how Graphic objects behave.

The Graphic object type (this type is called an "entity" in some systems) in the TurboCAD SDK encompasses different subtypes. For example, circles, polylines, text, and 3D solids are all different subtypes of the Graphic object.

Unlike some other CAD packages, Graphics in TurboCAD are arranged in a hierarchy; in other words, TurboCAD Graphic objects can contain child Graphic objects. Graphic objects can exist as independent objects. However, typically Graphic objects are "owned"-they usually exist in a hierarchy of ownership which descends from a Drawing or Block object.

Obviously, Graphic objects must specify geometry. One way that geometry is expressed in the TurboCAD engine through the hierarchy of parent and child Graphic objects. Another way that the geometry is expressed is that every Graphic object contains a collection of Vertex objects, accessible through the Graphic's Vertices collection.

Different subtypes of Graphics use the ordered Vertices collection to specify different parameters for the Graphic; for example, a polyline Graphic uses the vertices to specify the coordinates of the sequence of endpoints of the line segments that compose the polyline, whereas an arc Graphic specifies four different points in its Vertices collection that define the basis for the mathematical definition of the arc. The Vertex objects in the Graphic's Vertices collection also contain other information besides coordinate locations.

code example for showing vertices

Furthermore, each Graphic object contains a Matrix object that transforms the Graphic from a local coordinate system into its parent coordinate system. Since the Graphics form a hierarchy, these Matrix transformations are concatentated until the top of the hierarchy is reached.

code example for showing matrix

Is this right???

Details of how the Graphic is displayed is also specified by information accessible through the Graphic object. For instance, the dash-dot pattern of a 2D graphic may be obtained by querying the LineStyle object referenced from the Graphic, or the color of the line changed by using the PenColor extended property of the Graphic.

code example for showing LineStyle

For most Graphic subtypes, other extended properties (most of which are exposed to the TurboCAD user through the selection property pages) control all of the geometry and appearance of the Graphic.

code example for showing one extended property


TurboCAD's Graphic Hierarchy

At the top of the hierarchy is a graphic container. This is a collection object, typically exposed by a Drawing, Layer, Block, PaperSpace, or other object through that object's Graphics property:

Dim grs As Graphics
Set grs = ActiveDrawing.Graphics

A Block object (a hierarchy of Graphics that can be referenced though multiple insertions in a Drawing) is in many ways analogous to a Drawing, and it also has a root graphic. To access the Graphic hierarchy contained in a block, you would write:

Dim blk As Block
Dim grs As Graphics
Set blk = ActiveDrawing.Blocks("A_BLOCK_NAME")
Set grs = blk.Graphics

Other graphic containers that provide the top level of containment are the Selection and GraphicSet objects.

Below this top level container, Graphic objects are themselves containers; they expose a Graphics collection through their Graphics property, thus creating a nested or tree-like structure. Thus, TurboCAD and the SDK allow you to arrange Graphic objects in hierarchical groups. A group in TurboCAD is a just a Graphic subtype that typically has no vertices, only child Graphic objects.

For a more detailed description of how these graphic collections behave, see "Collections of Graphics".


Under the Hood of TurboCAD's Graphic Engine

The TurboCAD engine takes the parametric specification data contained within the Graphic objects to mathematically define the different Graphic subtypes. It also creates and maintains additional information (stored in the Graphic's Vertices, Graphics, and Properties collections).

Each Graphic subtype is manipulated by handler procedures that read and modify the information contained in a Graphic during the course of operations such as creation, destruction, copying and rendering of the Graphic. For some Graphic subtypes, like polylines, these handlers are contained within the core TurboCAD engine. We will call these "basic subtypes". Most Graphic subtypes are handled by extension DLL's ("Regen" or "Regen Method" DLL's that are placed in the Regens subdirectory) that extend basic functionality and allow for more sophisticated behavior. Using the SDK, you can define your own custom Graphic subtypes by creating these extensions. We will call this group of Graphic subtypes "Regens" for short. See the Advanced Projects section for a detailed explanation of how to build your own custom Graphic object subtype.

code example for finding regen

When operating with the data contained in the Graphic object, all handlers respect certain rules that are common to all Graphic subtypes. There are predefined "flags" attached to Graphic objects and their contents that help the handlers display and manipulate the data. For instance the selection state of the Graphic, and the availability of each of the Graphic's vertices for "node editing" are two abilities that are controlled by these flags.

Some of a Graphic's extended properties are shared by all Graphic subtypes. Others are specific to a particular type.

NOTE Be sure to provide error handling code for extended properties that may be listed but undefined. For more information see "Using the Property Object".


Basic Graphic Subtypes

The TurboCAD graphic system includes a small set of core subtypes that are used for handling primitive graphic elements such as polylines, arcs and circles, and viewports. The routines that work with these basic subtypes are contained within the DLL's in the TurboCAD Program directory.

Information about the layout of a basic subtype's vertices, child graphics and properties is provided in the "Basic and Regen Graphics In Detail" sections.


Regen Graphic Subtypes

As an extensible system, other graphic elements are built up from the basic subtypes. These extended subtypes are called "Regens" and the routines that handle them are packaged in DLL's in the TurboCAD Regens subdirectory. Examples of Regen subtypes that are shipped with TurboCAD are: double line, multiline, dimensions, ACIS solids. Text elements are also handled by the Regen system.

One Regen DLL (such as the dimension DLL) can support many subtypes (linear dimensions, radial dimensions, etc.). It is possible for you to write your own extensible subtype using Visual Basic or Visual C++. For more information on the Regen system, see the "Advanced Projects" section of the documentation.

Information about the layout of a regen subtype's vertices, child graphics and properties is provided in the "Basic and Regen Graphics In Detail" sections.


What's in a Graphic?

The following tables list the most commonly used properties and methods common to all graphic subtypes. Details of how to use these properties and methods will be introduced in later sections that provide information on how to accomplish common tasks with Graphic objects.

You can examine the standard and extended properties of a graphic, and its child hierarchy, using the "Extended Selection Info" sample macro.

Graphic Standard Properties
Property | Description
Parent | Returns parent object to which the Graphic object belongs. Should this be a paper space object if the graphic is in paper space?
Application | Navigation access to the Application object which owns this Graphic.
Drawing | Navigation access to the Drawing object which owns this Graphic.
ID | Integer: Unique identifier for the Graphic.
Type | String: Describes the Graphic's subtype.
Cosmetic | Boolean: True if the Graphic object is used for display regeneration only.
Editable | Boolean: True if the Graphic object can be edited in the user interface.
Visible | Boolean: True if the Graphic is to be drawn on the screen.
Closed | Boolean: True if the Graphic is closed (a segment connects the last Vertex in the Vertices collection to the first).
Unbounded | Boolean: True if the Graphic has no endpoints (e.g. for construction lines).
Selected | Boolean: True if the Graphic is part of the current selection.
BuiltIn | Boolean: True if the object is one of the core basic subtypes.
Root | Boolean: True if the Graphic is at the root of a hierarchy.
UCS | The Matrix object that transforms this Graphic into its parent's coordinate system.
Graphics | The collection of child Graphic objects contained by this Graphic object.
Vertices | The collection of the Graphic's vertices.
Nodes | The sub-collection of the Graphic's vertices that are node-editable.
Properties | The collection of the Graphic's extended properties.
Attributes | The collection of the Graphic's attribute properties. Are these actually Graphics?
Layer | The Layer object that represents the drawing layer that this Graphic is assigned to.
LineStyle | A LineStyle object that describes the pattern applied when drawing the outline or stroke of the graphic.
BrushStyle | A BrushStyle object that describes the pattern applied when drawing the filled area of the graphic.
RegenType | String: Describes the Graphic's subtype handler. Doesn't seem to be implemented.
Deleted | Boolean: True if the Graphic object is on the purge/undo list. Doesn't seem to be useful or implemented.
ZOrder | An Integer that is used to sort the Graphic in its collection during rendering. Not implemented.

Graphic Extended Properties
Property | Description
PenColor | Long: 24-bit RGB value of the color used to draw the outline or stroke of the graphic.
PenWidth | Double: Width of pen in model space or paper space units.
BrushColor | Long: 24-bit RGB value of the color used to draw the filled area of the graphic.
TextColor | Long: 24-bit RGB value of the color used to draw text graphics.

Graphic Methods
Method | Description
Duplicate | Creates an copy of a Graphic object in the collection that owns this Graphic.
Delete | Destroys the Graphic object and removes it from its parent collection.
Draw | Forces a rendering of the Graphic.
Update | Forces update of the Graphic object's properties.
Select, Unselect | Changes the selection state of the Graphic.
BringToFront, SendToBack | Changes the z-order of the Graphic to place it at the front or back of its collection's drawing order.
MoveAbsolute, MoveRelative | Translates the Graphic's position.
RotateAbsolute, RotateAxis | Rotates the Graphic's orientation.
Scale | Changes the scale of the Graphic.
Transform | Changes the Graphic's position, rotation and scale by using a Matrix multiplication.
Explode | Explodes a Graphic object and returns a GraphicSet object, which is a sub-collection containing the Graphics resulting from the explode operation.
LinearCopyAbsolute, LinearCopyRelative, RadialCopyAbsolute, RadialCopyRelative, ArrayCopyAbsolute, ArrayCopyRelative | Returns a GraphicSet object containing the results of a copy operation.
CalcBoundingBox | Calculates and creates a BoundingBox object for the Graphic.
GetDistance | Calculates the minimum distance from a specified 3D world location to the Graphic.
RegenLock, RegenUnlock | Methods used by regen handling routines to prevent re-entrant recalculation of cosmetic graphics. See the "Advanced Projects" section for details.


Cosmetic and Non-cosmetic Graphics

One of the key concepts in TurboCAD's graphic system is that of a "cosmetic" graphic. For a given graphic subtype, TurboCAD (or you as the author of a custom regen) use a specific list of vertices and properties that uniquely define the geometry of the graphic. However the graphic is often rendered not just as a polyline or arc connecting these defining vertices. Instead the regen handling routines generate a visible representation of the graphic when any of the defining vertices or properties are changed.

This visible representation is called a cosmetic graphic, and it is usually a polyline approximation, added as a child graphic to the defining graphic. The regen handler code maintains the state of this cosmetic graphic, destroying and rebuilding it every time the geometry or properties of the defining graphic are modified.

If you walk through the graphic hierarchy of a drawing that contains a regen graphic, you can identify these cosmetic graphics by a True value of a Graphic object's Cosmetic standard property.

Show example

Normally only the regen handling code itself should attempt to modify these transient cosmetic graphics. Do not hold references to cosmetic graphics in your Visual Basic for Applications code for long periods of time-an individual cosmetic graphic's lifetime may only last for the duration of one rendering pass.


Editable and Non-Editable Graphics

Another property that you can inspect and modify is a Graphic object's Editable property. By setting this property to False, you can disable modification of the object in the user interface. Most graphics are meant to be fully Editable, and it is generally not recommended that you change the Editable state of cosmetic graphics.


Model Space and Paper Space Graphics

Graphics exist in one of two workspaces in a Drawing: Model Space or Paper Space. When you add the graphic to a Drawing object's Graphics collection, the current space setting determines which space the graphic belongs to. Most of the examples in this documentation concerning graphics assume that you will use Model Space to build most graphics. See the section on Working with Paper Space for more information.

How can you determine which space the Graphic is in if you have a reference to it?


Defining Graphic Geometry: Using the Vertices Collection

Querying or modifying a Graphic object's shape or position usually involves accessing its vertices. For some Graphics, such as the polyline, you the programmer have full control over adding, removing or modifying the contents of the Graphic's Vertices collection. Other more sophisticated types impose restrictions on the number and meaning for particular vertices. These rules and restrictions will be discussed under in the topics that explain specific Graphic subtypes. The examples and explanations that will be discussed here assume that you are working with the simplest kind of Graphic object, the polyline.

You can examine the vertices that define a graphic using the "Extended Selection Info" sample macro.


What's in a Vertex?

A Vertex object in a TurboCAD drawing is a point in three dimensional space. Vertex objects can be created as standalone, independent objects, or can be accessed as part of a Graphic object's Vertices collection contents.

The Vertex object serves to specify the 3D location of a control or reference point for its containing Graphic object. Modifying a Vertex object allows to reshape the parent Graphic object.

Other properties of the Vertex object control the visibility of segments that connect sequential vertices, and the curvature of arc segments in the polyline Graphic. You can also affect the behavior of many aspects of the user interface by setting Boolean properties that control selecting, snapping, and node editing capabilities.

Vertex Properties
Name | Description
Parent | If the Vertex is contained within a Graphic's Vertices collection, this returns the Graphic object.
Application | Navigation access to the Application object which owns this Vertex.
X | Double: X coordinate value of the vertex.
Y | Double: Y coordinate value of the vertex.
Z | Double: Z coordinate value of the vertex.
ID | Integer: A user-defined value that can be used to identify the Vertex.
Bulge | Boolean: True if this Vertex is an off-curve point that specifies an arc segment.
PenDown | Boolean: True if the line or arc segment from this point to the next vertex will be drawn.
Selectable | Boolean: True if the vertex can be selected in the user interface.
Editable | Boolean: True if the vertex can be "node edited" in the user interface
Snappable | Boolean: True if the vertex can be snapped to in the user interface.
Linkable | Boolean: True if the vertex can be linked to. For example only certain vertices on dimension graphics can be tied to other graphics.
Calculated | Boolean: True if the vertex is calculated from the graphic's geometry. The Calculated property allows for "cosmetic" vertices in non-cosmetic graphics.

Vertex Methods
Name | Description
Duplicate | Creates a copy of the vertex in the same collection as the original.
Delete | Removes the vertex from its owning collection.


Using a Vertex Object

To create a Vertex object prior to filling it with coordinates and other information, you can use the New statement:

Dim vtxNew As New Vertex
vtxNew.X = 1
vtxNew.Y = 2
vtxNew.Z = 3

To access a Vertex that is part of a Graphic's Vertices collection, you use standard methods for collections:

Dim gr As Graphic
Dim vtx As Vertex
Set gr = ActiveDrawing.Graphics(0)
Set vtx = gr.Vertices(0)


Adding a Vertex to a Graphic

If you are dealing with polylines, you can add new points to the polyline as follows:

Dim gr As Graphic
Dim vtx As Vertex
Set gr = ActiveDrawing.Graphics.Add
Set vtx = gr.Vertices.Add(0, 0, 0)
Set vtx = gr.Vertices.Add(1, 0, 0)
Set vtx = gr.Vertices.Add(1, 1, 0)

Warning Adding or Removing a Vertex from most Graphic subtypes might result in undefined behavior, including an application crash. Consult the documentation on specific Graphic subtypes for more information.

You can also insert new vertices into a polyline graphic by using the AddVertex method. This transfers ownership of the Vertex to the collection, and also allows you to control the index of the vertex in the collection. To insert a vertex after the third vertex (in other words, after the vertex with index 2):

Dim vtxNew as New Vertex
vtxNew.X = 0
vtxNew.Y = 1
vtxNew.Z = 0
gr.Vertices.AddVertex vtxNew, After:=2

If you are building a closed polygon, you can specify that the final vertex closes the polygon (ensuring that its coordinates will match the first vertex's, and setting the owning Graphic's Closed property to True) by using the AddClose method:

Set vtx = gr.Vertices.AddClose


Removing Vertex Objects from a Graphic

You remove a Vertex object from a Graphic's Vertices collection using the Remove method. This makes the Vertex ownerless. To remove the third vertex (the vertex with index 2):

Dim gr As Graphic
Dim vtx As Vertex
Set vtx = gr.Vertices.Remove(2)

If you already have a reference to a Vertex in a collection, you can achieve the same result by using the Delete method:

Dim gr As Graphic
Dim vtx As Vertex
Set vtx = gr.Vertices(2)
vtx.Delete

After the Vertex object has been removed, it is a standalone Vertex, and it will be destroyed as soon as all references to it go out of scope. You can force its destruction in the usual way:

Set vtx = Nothing

Warning Adding or Removing a Vertex from most Graphic types might result in undefined behavior, including an application crash. Consult the documentation on specific Graphic subtypes for more information.


Using Vertex Coordinate Values

The values of a coordinate property (X, Y, Z) in a Vertex that is part of a Graphic's Vertices collection can be specified in either the world coordinate system (WCS), shared between all Graphics in a drawing, or in the local coordinate system (LCS) of a Graphic object. Internally a Vertex object always stores its coordinates in LCS of the Graphic object it belongs to.

Before getting or setting the coordinate values, you can control the coordinate system, WCS or LCS, that you wish to work in. If you choose, the conversion to or from the WCS to the internal LCS is made at the time you get or set one or more of its X, Y, or Z properties.

To specify a coordinate system use UseWorldCS property (Boolean) of the Vertices collection that a particular Vertex object belongs to. Setting this property to TRUE will automatically convert LCS to WCS and vice versa.

The UseWorldCS property's scope is directly related to the Graphic object. This means that this property setting exists only as long as the corresponding Graphic object exists.

The UseWorldCS property is meaningful only the Vertex objects of the given collection, and does not affect higher hierarchy objects, e.g. Graphic. Also setting this property for Vertices collection of a parent Graphic object does not automatically set this property for Vertices collections of child Graphic objects.

More details on working with World and Local Coordinate Systems are discussed in the section World and local coordinate systems.


Graphic Position and Orientation: Using The UCS Matrix Object

A Matrix object encapsulates a 4x4 transformation. Matrix objects can be created by means of the New statement, which generates a reference to an identity transformation matrix:

Sub DebugMatrix(ByVal mtx As Matrix)
    Dim i, j As Integer
    Dim row As String

    For i = 0 To 3
        row = ""
        For j = 0 To 3
            row = row + CStr(mtx.GetEntry(i, j)) + "  "
            Next
            Debug.Print "row " & I & ": " & row
        Next
    Next
End Sub

Dim mtxIdentity As New Matrix
DebugMatrix mtxIdentity

Each Graphic in model space owns a Matrix that describes the transformation from its own user coordinate system (UCS) to its parent's coordinate system. This matrix is always a combination of pure rotation and translation (no scaling or shear is allowed). In paper space, Graphic objects are pre-transformed, so their UCS Matrix always returns an identity matrix.

Dim gr As Graphic
Dim mtxUCS As Matrix
Set mtxUCS = ActiveDrawing.Graphics(0).UCS
DebugMatrix mtxUCS

We'll discuss using matrices more under the Move, Copy, Transform sections; maybe we should just move this whole section there

How does this relate to workplanes in the user interface?


Attaching Data to Graphics Using Custom Graphic Properties

Because all Graphic objects have extended and custom property capabilities, you can attach your own arbitrary data to any graphic contained in a drawing. Just create the data and assign it to a named custom property.

NOTE Data added to cosmetic graphics via the use of custom properties is likely to be lost as the cosmetic graphics are rebuilt. Instead, always add the custom property to the parent, non-cosmetic graphic.

NOTE Custom properties are copied to new graphics as the result of copying and duplicating operations, either through the SDK or the user interface. If you want to maintain independent data for newly copied graphics, you must do it manually.


Adding a Custom Property

To add a custom property, supply a unique name and use the Properties collection's Add method:

Dim gr as Graphic
Dim newProp as Property
Set gr = ActiveDrawing.Graphics.AddSquare 'any old graphic will do
Set newProp = gr.Properties.Add("Weight")
newProp.Value = 10#
Debug.Print "The name of the new property is " & newProp.Name
Debug.Print "The type of the new property is " & prop.Type
Debug.Print "The current value of the new property is " & prop.Value

Note that by setting the Value, the custom property system will automatically detect and set the Type property of the object. In the case above, the "Weight" property was assigned a Visual Basic double-precision number, so the Type property will return vbDouble.

A Graphic's custom properties are automatically copied when the Graphic itself is copied. However the custom property does not automatically become attached to all Graphic objects of a given type, just the specific Graphic object that it has been created for.


Removing a Custom Property

Any property that you add through TurboCAD's custom property mechanism can be removed via the Property object's Delete method:

gr.Properties("Weight").Delete


Graphic Appearance: Using Colors, Styles, and Patterns


Changing the Color of a Graphic

Three extended properties, PenColor, BrushColor, and TextColor control the colors that are used to render a Graphic object. You can query these properties and modify them to change the Graphic's colors. Since they are extended properties, they may not exist for all Graphic subtypes, and you must refer to them using extended property syntax.

The type of these color properties is a Long, which represents a 24-bit packed value in the RGB (Red/Green/Blue) color space. Each component of the RGB color value can take an integral value from 0 to 255. To obtain the individual red, green or blue values, you can use code such as the following:

example showing use of these three

In addition to the 24-bit packed color values that you can assign to these properties, there are 4 contextual color values that you can use:

Contextual Color Values
Value | Description


Using Named Colors

TurboCAD uses an internal list of human-readable color names, such as "red", or "green", to display colors in its user interface. Each named color has associated properties, representing the intensities of the color as seen in the Red, Green and Blue channels of the RGB color space. For example, the named color "red" represents an intensity of 1.0 in the Red channel and 0.0 in the Green and Blue channels. The Windows operating system quantizes these intensities into 256 integer values (from 0 to 255) for each of the three channels, storing the RGB values in a 24-bit integer. Working with graphics in a drawing you can use the color names, Red, Green and Blue intensities, and 24-bit RGB values to assign colors to graphic objects, or create new colors. You can also work with another color space, the Hue-Saturation-Brightness or HSB system, and convert between one color space and the other.

The following example iterates through the NamedColors collection and prints each NamedColor name in the Immediate Window:

Dim nclr As NamedColor
For Each nclr In Application.NamedColors
      Debug.Print nclr.Name
Next

You can access a particular named color in the NamedColors collection by name:

example

You can add your own custom colors to this collection, by using the NamedColors.Add method:

example of adding a new named color to the named color collection


Using the NamedColor Object

The NamedColor object supports several properties for working with color:

NamedColor Standard Properties
Name | Description
Name | String. The name that identifies the named color.
Color | Long. The color's packed 24-bit RGB value.
Red | Double. The red component of the color, as a fraction in the range 0 to 1.
Green | Double. The green component of the color, as a fraction in the range 0 to 1.
Blue | Double. The blue component of the color, as a fraction in the range 0 to 1.
Hue | Double. The hue component of the color, as a number from 0 to 1. A pure blue hue has a value of 0 or 1, pure green is 0.333, pure red is 0.667, and intermediate values are blends.
Saturation | Double. The saturation component of the color as a fraction in the range 0 to 1. A saturation value of 0 represents a fully gray color (no red, green or blue contribution from the current hues), and a value of 1 represents the pure hue, with no grayness mixed in.
Brightness | Double. The brightness component of the color as a fraction in the range 0 to 1. A brightness value of 0 represents black, no matter what hue or saturation have been chosen, and 1 represents the full color.

You use the Color property to set a Graphic's PenColor, BrushColor, and TextColor property values, or a Drawing's BackgroundColor or PaperColor property values.

example of using named color to set graphic color

The NamedColor object allows you to get and set information about a color in the HSB ("Hue/Saturation/Brightness") color space. This is an alternate way to specify color information, that makes it easier to distinguish between different colors, and to modify colors in a palette of related tones. You can make a temporary NamedColor object and use it to convert between the RGB color space and the HSB color space. Note that individual color components in NamedColor objects are "normalized", that is, they all fall in the range from 0 to 1.

The following gives an example of how to use the HSB color space to specify related colors for a Graphic:

example


Using Line Styles

BrushStyle and LineStyle objects can also be accessed through Graphic object. However, these objects cannot be created using Graphic object since Graphic object can only work with existing objects. To create new BrushStyle, and LineStyle objects you must access a respective collection though the Drawing object.

Each Drawing contains a LineStyles collection that contains specifications for line drawing patterns. You can obtain information about a Graphic's line style through the LineStyle property, or set the line style by obtaining a LineStyle object from the LineStyles collection:

examples

You can also create new line style patterns and add them to the collection.

example


The LineStyle Object

The LineStyle object has properties that you can use:

LineStyle Properties
Name | Description
Name | String. The name that identifies the line style.
PatternLength | Double. The repeat length of the pattern.
Dashes | Double(). The array of dashes that consitute the pattern.

Need to give example


Using Brush Styles

similar text about brush styles


The BrushStyle Object

The BrushStyle object has properties that you can use:

BrushStyle Properties
Name | Description
Name | String. The name that identifies the brush style.
Type |
Color |
HatchStyle |
Bitmap |
Patterns |

example of changing color or bitmap


The BrushPattern Object

To specify new brush patterns contained in a brush style, you use the BrushPattern object. A brush pattern consists of a collection of individual vector items. Each item consists of a starting position (X and Y coordinates in the pattern space), height and width, and a rotation angle. You can query and modify the individual items by using these methods:

BrushPattern Methods
Name | Description
Count |
AddItem |
RemoveItem |
GetItem |
SetItem |

example of changing brush pattern info

note: Style Object is not implemented

question: any SDK interface for materials on 3D objects?


Using Graphic Collections

Before you can really begin to manipulate graphics effectively, it's important to understand the concept of ownership, and how different collection objects in the SDK maintain references to Graphic objects. A Graphic object can come into existence either as a standalone object, created by a New statement, or as an object owned by a collection, through a method invoked on a Graphics collection.

The containers that take ownership of the Graphic objects within them are the Drawing object, the Block object, and the Graphic object (since Graphic objects are maintained in a hierarchy). Each of these objects exposes a Graphics collection. These Graphics collection objects have strict ownership over the individual Graphic objects within them.

In addition, there are non-owning collections. These collections refer to the Graphic objects which are either standalone, or are owned by one of the primary Graphics collections. Examples of these non-owning collections are the GraphicSet (which is an arbitrary assemblage of Graphic objects that you can create to hold references to Graphics), the Selection object exposed by a Drawing, and the Graphics collection exposed by the Layer object. The PickEntry object can be thought of as a collection that references a single Graphic object, but does not own it.

The Layer's Graphics collection and Drawing's Selection object are special in that they are "sub-collections". They enumerate individual Graphic object elements of a Drawing's Graphics collections that meet specific criteria: either that the Graphic is attached to a particular layer, or that it's selection state is set.

The following matrix summarizes the different types of graphic collections that are available in the TurboCAD object model:

Graphic Collection Objects
Type of Collection | Types that own contained Graphic objects | Types that hold references to contained Graphic objects, but do not own them
Full collection | Drawing.Graphics Block.Graphics Graphic.Graphics PaperSpace.Graphics (deprecated) | GraphicSet (contained graphics can be standalone or owned by any other collection)
Sub-collection of full collection (full collection shown in parentheses) |  | Layer.Graphics (Drawing.Graphics) Drawing.Selection (Drawing.Graphics) PaperSpace.Selection (PaperSpace.Graphics) (deprecated)
Other objects that hold Graphic references |  | PickEntry (a "collection" of a single Graphic. Graphic is owned by Drawing.Graphics)


The Drawing Object's Graphics Collection

The Graphics сollection of a Drawing object provides access to individual Graphic objects in a drawing's active space. Depending on the Drawing's TileMode property value and the active PaperSpace, this collection will return different contents, reflecting the graphics contained in the particular workspace. More information on how model space and paper spaces interact with Drawing properties can be found in the "Working with Model Space and Paper Space" section.

Using the the Graphics collection you can:

· Create new Graphic objects.

· Iterate through Graphics collection.

· Manipulate all the Graphic objects in a drawing in batch operations.

· Destroy individual Graphics or the entire contents of the collection.

Since TurboCAD's graphic system allows for hierarchical groups and employs child cosmetic graphics, the Drawing's Graphics collection will just contain the "top-level" graphics, that are shown in the user interface.

Once you have access to the top-level graphics of a drawing, you can navigate down the hierarchy. For instance, you can use the a Graphic object's Graphics collection to get information or modify child graphics in a group.


Using Navigational Properties of a Graphic

Each Graphic object has properties that allow you to find out who its owner is, and to navigate up the object model hierarchy from a Graphic object to a Graphic collection.

Getting the Parent property returns an Application, Drawing, or Block object, depending on whether the Graphic is standalone, owned by a Drawing or owned by a Block.

Getting the Drawing property returns the Drawing object that the Graphic is contained by. Standalone Graphic objects return Nothing for this property. Setting the Drawing property of a Graphic to a Drawing automatically forces the removal of the Graphic from its current owner (if any) and transfers ownership to the new Drawing.

Getting the Block property returns the Block object that the Graphic is contained by. Standalone Graphic objects return Nothing for this property. Setting the Block property of a Graphic to a Block automatically forces the removal of the Graphic from its current owner (if any) and transfers ownership to the Block (which in turn is contained by a Drawing's Blocks collection).

Getting the Layer property returns the Layer object that the Graphic is attached to. Standalone Graphic objects return Nothing for this property. Setting the Layer property of a Graphic to a Layer automatically forces the removal of the Graphic from its current owner (if any) and transfers ownership to the Drawing which contains the Layer.

verify this with example code

To move down the object model hierarchy, you use the Graphics collection exposed by the Drawing, Block, or Graphic objects.

NOTE Block and Layer objects are always owned by a Drawing. To create new Block or Layer objects you must access a respective collection though the Drawing object.


Creating a Standalone Graphic Object

You can create a standalone Graphic object, that is not part of any drawing by using Visual Basic's New statement.

For example the following shows how a standalone graphic is created and destroyed:

    Dim gr As Graphic
    'Create standalone graphic
    Debug.Print "Creating standalone graphic"
    Set gr = New Graphic
    'Zero graphics in drawing
    Debug.Print "Now " & ActiveDrawing.Graphics.Count & " graphics in drawing"
    'Parent is IApplication
    Debug.Print "Parent type: " & TypeName(gr.Parent)
    'Graphic is NOT in drawing -- it's standalone
    Debug.Print "Graphic in drawing? " & (Not gr.Drawing Is Nothing)
    'Graphic will be destroyed
    Set gr = Nothing
    'Still zero graphics in drawing
    Debug.Print "Now " & ActiveDrawing.Graphics.Count & " graphics in drawing"


Creating a Graphic Owned by a Collection

Normally, you create a Graphic in the context of an owning collection, either a Drawing or a Block.

Here's an example that creates a graphic owned by the active drawing:

    Dim gr As Graphic
    'Create owned graphic
    Debug.Print "Adding graphic"
    Set gr = ActiveDrawing.Graphics.Add
    'One graphic in drawing now
    Debug.Print "Now " & ActiveDrawing.Graphics.Count & " graphics in drawing"
    'Parent is IGraphic -- bug?
    Debug.Print "Parent type: " & TypeName(gr.Parent)
    'Graphic is in drawing
    Debug.Print "Graphic in drawing? " & (Not gr.Drawing Is Nothing)
    'Graphic will NOT be destroyed -- we just lost a reference to it
    Set gr = Nothing
    'Still one graphic in drawing
    Debug.Print "Now " & ActiveDrawing.Graphics.Count & " graphics in drawing"


Destroying a Graphic Owned by a Collection

To delete the graphic you just added to the collection, there are two methods. If you have a reference to the graphic you can use the Graphic object's Delete method, which removes the Graphic from the collection and destroys it:

    'Delete owned graphic
    Debug.Print "Deleting graphic"
    gr.Delete
    Set gr = Nothing
    'Zero graphics in drawing now
    Debug.Print "Now " & ActiveDrawing.Graphics.Count & " graphics in drawing"

To delete all the Graphics in the collection, you can use the collection's Clear method:

ActiveDrawing.Graphics.Clear


Removing a Graphic from an Owning Collection

If you know the position or the Graphic in the collection, you can make it standalone again by using the collection's Remove method:

    Dim gr As Graphic
    Dim i As Integer
    'Remove graphic from collection -- make it standalone
    Debug.Print "Removing graphic from collection"
    Set gr = ActiveDrawing.Graphics.Remove(i)
    'Zero graphics in drawing now
    Debug.Print "Now " & ActiveDrawing.Graphics.Count & " graphics in drawing"
    'Parent is IGraphic -- bug?
    Debug.Print "Parent type: " & TypeName(gr.Parent)
    'Graphic is in drawing
    Debug.Print "Graphic in drawing? " & (Not gr.Drawing Is Nothing)
    'Release (and destroy) standalone
    Set gr = Nothing


Child Graphics: Creating a Group Hierarchy

If you want to create hierarchical groups of graphics that inherit copying and selection behavior from their parent, you can add child Graphic objects to a top-level group Graphic. A group Graphic is just a Graphic object (type is usually "GRAPHIC") that has no vertices of its own, and is just a container for child Graphic objects. You can create a group by using the Graphic collection's Add method.

Once you have created an empty group Graphic, you can add new graphics or move existing graphics into the group.

Bug: DBAPI Internal Failure when trying to move graphics from drawing into group. Workaround in the source code below.

Here's an example that takes the Graphics in the current selection, and makes them children of a new group Graphic.

Dim grGroup As Graphic

    'First make a group container
    Set grGroup = ActiveDrawing.Graphics.Add
    'Then add in the selected objects
    'This is made difficult because you the Selection object is not mutable
    'So we need to save the Graphic ID's in an array
    i = 0
    ReDim ids(0 To count - 1)
    For Each gr In ActiveDrawing.Selection
        ids(i) = gr.ID
        i = i + 1
    Next
    'Now recapture the ids and add the graphics to the group
    For i = 0 To count - 1
        Set gr = ActiveDrawing.Graphics.GraphicFromID(ids(i))

        'Selected no more
        gr.Unselect

        'Internal DBAPI Failure if you don't remove the graphic first
        ActiveDrawing.Graphics.Remove gr.Index
        grGroup.Graphics.AddGraphic gr
    Next


Removing a Graphic from a Group

Graphic objects can be removed from a group the same way that they are removed from a Drawing: by using the child Graphic object's Delete method, or the group Graphics collection's Remove method:

Need example

If all the graphics previously contained within a group have been removed, the empty group is not automatically destroyed. You can destroy an empty or non-empty group just as you would any other top-level Graphic, by calling its Delete method, or by removing it from the owning Drawing's Graphics collection.

Need example


Exploding a Group

Another useful technique is to create a temporary group, perform some operation (such as a transformation or LineStyle change) on the group and its children and then explode the group. The result of this is that the children that were added to the group are now owned by group's owning collection (usually a Drawing), and the group object itself is destroyed.

Need example


Using the Selection Object

Graphic objects maintain a True/False selection state. The TurboCAD user interface has what is called a noun-verb action paradigm. To perform most operations in the user interface, you first create or add to a selection (the "noun"), and then choose an operation to apply to the selection (the "verb"). You can build the selection using the SDK, so that when your macro stops, the user interface is ready to apply an operation.

The selection state of a single Graphic object can be determined by getting the value of its Selection readonly property. You change the selection state of a Graphic object by using its Select and Unselect methods, or by adding it to a drawing's Selection collection.

The Drawing object's Selection object is a non-owning sub-collection of top-level Graphics in a drawing that are the result of a selection in the user interface. Graphic objects move into and out of this collection as the user performs selection operations. A common technique for Visual Basic for Application macros is to prompt for a selection operation, and then act on the contents of the Selection object.


Adding Graphics to the Selection

You add a Graphic object to the Drawing's Selection object by calling the Graphic's Select method. To select all the Graphic objects that belong to the Drawing object's Graphics collection use the Drawing object's SelectAll method. The SelectAll method of the Drawing object is synonymous to Select method of the Graphics collection (Drawing.Graphics.Select).

Need example

Other Graphics collections (GraphicSet and Layer) also have a Select method that selects all the Graphic objects in their contents.

Each Graphic has a Selected Boolean property that is True if the Graphic is part of a Drawing's Selection.

What happens to selections as other spaces are activated?


Removing Graphics from the Selection

You remove a Graphic object from the Drawing's Selection object by calling the Graphic's Unselect method. To unselect all previously selected Graphics objects in a Drawing use the UnselectAll method of the Drawing object. This method has a synonymous Unselect method in the Graphics collection (Drawing.Graphics.Unselect).

Need example

Other Graphics collections (GraphicSet and Layer) also have an Unselect method that unselects all the Graphic objects in their contents.


Graphics and Layers

Every Graphic that is owned by a Drawing or Block is assigned to a layer. You use the Drawing object's Layers collection to enumerate and modify the properties of layers in a Drawing, add new layers or delete existing layers.

A Layer is a virtual level in a drawing allowing to organize, i.e. logically group Graphic objects depending on their functionality, common uses, etc. For instance when creating a sophisticated building design you may want create subsets of such groups of Graphic objects as walls, electric fixtures, pipelines, etc.

This can be done through creation of separate layers for each functional group of objects. Layers allow you to work with each functional group of Graphic objects independently, with no interference of other Graphic objects or groups.

A new blank drawing has one default layer named "0". It is not recommended to rename or remove this default layer.

For more about how a layer can be used as a container of graphics, see Section 10, Collections of Graphics.


Creating a Layer

The following example creates three new layers in an active drawing for our hypothetical building project:

With ActiveDrawing.Layers
    .Add "Walls"
    .Add "Electrical"
    .Add "Piping"
Dim lyr As Layer
For Each lyr In ActiveDrawing.Layers
      Debug.Print lyr.Index & ": " & lyr.Name
Next


Destroying a Layer

To destroy a layer, you use the Delete method of the Layer object. However, you cannot destroy a layer if any Graphic objects are assigned to it. To destroy a non-empty layer first you need to destroy all Graphic objects with Layer property pointing to this layer. The easiest way to accomplish this is to use the Layer collection's Clear method and then destroy the layer:

Dim lyr As Layer
Set lyr = ActiveDrawing.Layers("Electrical")
lyr.AddSquare
lyr.AddCircle
lyr.Clear
lyr.Delete
Set lyr = Nothing


Using the Layer Object

You can use the following Layer object properties to control the behavior of all Graphics assigned to the layer:

Layer Standard Properties
Property | Description
Application |
Drawing |
Parent |
Name | The name of the layer, which can be used to index the Layers collection.
Index | Integer: The position of the Layer within the Layers collection.
Visible | Boolean: True if graphics assigned to this layer will be drawn.
Editable | Boolean: True if graphics assigned to this layer can be modified.
Color | The color value that will be applied to graphics on this layer whose PenColor or BrushColor properties are set to "ByLayer"
LineStyle | The LineStyle object that will be applied to graphics on this layer whose LineStyle property is set to "ByLayer".
BrushStyle | The BrushStyle object that will be applied to graphics on this layer whose BrushStyle property is set to "ByLayer".
Zorder | Priority by which graphics will be drawn.

Layers can be visible and invisible. If you want to work with a subset of Graphic objects in particular layer in your drawing, make all other layers invisible.

Layers can also be editable and non-editable. Making a layer non-editable protects Graphic objects in this layer from unintentional changes to those Graphic objects while someone is working with other Graphic objects in the same drawing.

To make a layer invisible set its Visible property to False. To protect a layer make it non-editable by setting its Editable property to False.

Use Color property to assign a specific color to a layer. If you want Graphic objects created in this layer to have color specified for that layer, set their Color property to "ByLayer", e.g.:

Dim gr As Graphic
'draw a circle
Set gr = ActiveDrawing.Graphics.AddCircle(0, 0, 0)
'place it into "Electrical" layer and assign it the layer's color
gr.Layer = "Electrical"
gr.Color = "ByLayer"

LineStyle and BrushStyle properties are similar to Color property, i.e. they allow to change the default appearance of Graphic objects in a particular layer.

The ZOrder property allows to change the layers drawing order. You can re-arrange layers' drawing order to change the order of appearance for Graphic objects in a drawing, i.e. you may specify which objects will be sent to back or front.


Accessing the Graphic Objects Assigned to a Layer

Since the Layer object is a collection, you can enumerate all the Graphics assigned to the Layer by using the For Each or indexing techniques:

Dim gr As Graphic
For Each gr In ActiveDrawing.Layers("0")
    Debug.Print gr.Type
Next


Adding a Graphic to a Layer

You can use the Layer object to construct Graphic objects immediately assigned to the layer, by using any of the Add methods exposed by the Layer object:

Set gr = lyr.AddSquare


Assigning a Graphic to a Layer

Each Graphic object has a Layer property that you can use to place Graphic objects on a layer. Once you've created a layer you can assign either its name or a reference to the Layer object to the Layer property of any Graphic object in your drawing:

gr.Layer = "Electrical"

Since the Layer object is a collection, another way to assign a Graphic to a Layer is to use the Layer's AddGraphic method:

lyr.AddGraphic gr


Graphics and Blocks

In TurboCAD a Block is a group of Graphic objects combined together into one object. Combining Graphic objects into a block is useful, for instance, when when you design a complex machine part that might be used as single entity in various places of a drawing (or in other drawings). A Block object inserted into a drawing is treated as one object, i.e. you can scale, rotate, delete as one object.

When you insert a Block into a drawing you don't add the whole combination of Graphic objects comprising the Block, instead you create a "Block insertion" Graphic object in the drawing. To modify all Blocks in a drawing you only need to modify the original Graphic objects in the Block.


What's in a Block?

Block Standard Properties
Property | Description
Application |
Drawing |
Parent |
Name | The name of the block, which can be used to index the Blocks collection.
Index | Integer: The position of the Block within the Blocks collection.
Graphics | The collection of Graphic objects that will be inserted by insertions which reference this Block.
Anchor | A Vertex object owned by the Block, which holds the X, Y, and Z coordinates of the origin of the Block.
XRef | Boolean (readonly): True if the Block is an external reference to another drawing.
XRefPath | String: If the Block is an Xref, this property holds the location of the external drawing.


Creating a Block

To create a Block, you call the Add method of a Drawing object's Blocks collection, specifying the name of the new Block and passing a reference to a single graphic or group of graphics that will make up the Graphics collection owned by the Block. When the Block is created, its Graphics collection will contain the single graphic or group. You can also specify the anchor point (origin) of the new Block by supplying X, Y and Z coordinates. If these are omitted, the anchor point is set at the center of the single graphic or group's bounding box.

This is not such a great interface. Other options would be to allow passing a GraphicSet as well, or making the parameter optional, allowing users to first create the (empty) block, and then add graphics to it.

How will we handle the AddBlockAttribute stuff, if we want to maintain the "insert right away" functionality?

The implementation code also appears to pull drawing ownership from the group, not from the Blocks collection…

The following example draws a simple picture of a nut, creates a Block object using the picture's Graphic objects, and then inserts the Block object two times into the drawing:

Dim grs As Graphics
Dim grGroup As Graphic
Dim blks As Blocks
Set grs = ActiveDrawing.Graphics
'Create a group to hold individual Graphics for the Block
  Set grGroup = grs.Add(imsiPolyline)
'Draw a nut (add Graphics to group)
  With grGroup.Graphics
    .AddLinePolygon 5, 5, 0, 6, 5, 0, 6
    .AddCircleCenterAndPoint 5, 5, 0, 5 + 1 * Sin(3.14159 / 3), 5, 0
    .AddCircleCenterAndPoint 5, 5, 0, 5 + 0.5, 5, 0
  End With
'Create block using the group
  Set blks = ActiveDrawing.Blocks
  blks.Add "NutBlock", grGroup, , , , False, False, False
'The group is now gone from the drawing
'Insert two blocks into drawing
  grs.AddBlockInsertion "NutBlock", 2, 7, 0
  grs.AddBlockInsertion "NutBlock", 7, 2, 0


Creating an XRef Block

XRefs (references to other drawings) are a special kind of Block in TurboCAD. To create a new XRef, you call the AddXRef method of the Blocks collection, passing in the name for the new Block, and the path to the referenced drawing, as well as the optional anchor point (origin) coordinates.


Destroying a Block

Block objects are destroyed in the usual way, through a call to the Block object's Delete method. A block will not be deleted from a drawing, and an error will be raised, if there are any block insertions in the drawing that refer to the block. The only way to remove a block with referring insertions, is to enumerate the drawing's graphic's collection and delete the insertions first.


Block and Insert Attributes

Attributes are exposed as Properties also. See the section on blocks and inserts for how to add these.


Creating a Graphic Set

In a TurboCAD drawing you can combine any Graphic objects into a graphic set. The GraphicSet object provides a convenient way to hold references to a list of Graphics in a particular drawing that are otherwise unrelated. To add Graphic objects to a graphic set first you need to create a GraphicSet object using a drawing's GraphicSets collection:

Set gset = ActiveDrawing.GraphicSets.Add ("MyGraphicSet")

The following example creates three GraphicSets and prints their names to the Debug Window:

Sub CreateGraphicSets()
Dim dwg As Drawing, i As Integer
    Set dwg = ActiveDrawing
    For i = 1 To 3
        dwg.GraphicSets.Add "MySet" & i, False
    Next i
    For i = 0 To dwg.GraphicSets.Count - 1
        Debug.Print i + 1 & ": " & dwg.GraphicSets(i).Name
    Next
End Sub


Adding Graphics to a GraphicSet

After you have created a GraphicSet object you can add to it any Graphic object belonging to this drawing using the GraphicSet object's Add method:

Dim gr As Graphic
Set gr = ActiveDrawing.Graphics(0)
gset.AddGraphic gr

Combining Graphic objects into a GraphicSet is useful when you are working with a drawing that has many Graphic objects, and you want to subdivide them into groups using certain criteria (geometrical properties, color, user-defined property, etc.). GraphicSets as groups of Graphic objects sharing a common property provide a convenient way to perform operations on groups of Graphic objects meeting certain criteria. GraphicSet objects are returned by some methods of the Graphics collection, such the Explode and QuerySet.


Removing a Graphic from a GraphicSet

As with other collections you can remove Graphic objects from a GraphicSet by calling the GraphicSet's Remove method. Do not use Graphic.Delete unless you really want to destroy the Graphic.


Using the TurboCAD Graphic Query Engine

TurboCAD contains a lightweight database query engine, that you can use to find Graphics in a drawing that match a variety of criteria. The Graphics collection's QuerySet method launches the query engine and returns a result set containing the Graphics that satisfy the query criteria contained in a GraphicSet object. To search a drawing for Graphics that have a red pen color, for instance, you could use the following code:

Set gset = ActiveDrawing.Graphics.QuerySet("PenColor=255")

Need specification for query language

Need example


Batch Operations on Graphic Collections

Need to check implementation status


Common Uses of Graphic Objects

Note: this section should come AFTER introduction of graphic collections

Each topic should mention whether the same type of operation can be applied to parent Graphics collection, Layer, Selection, and/or GraphicSet collections. Maybe a small table could be placed in each topic to describe this

Linking Graphics Together: Ties and TieSets. TieSet stuff should probably go into Advanced section only

This section will discuss typical operations on graphics that you can use in the SDK.


Creating Graphics of Different Types

The Graphics and some of the other collections allow you to create Graphic objects of different types. Each of the basic Graphic subtypes in TurboCAD has one or more "shortcut" methods exposed by the Graphics collection. Each method lets you specify the resulting geometry in different ways. For example you can create a circle by specifying its center and radius, by two points on its diameter, etc. In addition the more general Graphics.Add method lets you create an "empty" graphic of an arbitrary subtype and then modify its vertex coordinates and child graphics after it has been created.

Examples for a few common Graphics.AddXXX methods

Some basic subtypes require more than a single call to a method to set them up. For example, polylines and polygons are created initially with no vertices. You make one method call to add each vertex, and finish the creation of the polyline with an AddClose call if the polyline is a closed figure. The following example creates a polyline approximating a sine wave:

Need example

If you know how the properties and geometry of TurboCAD's Regen graphics work, you can also create these subtypes using the Graphics.Add method as well. Ususally you create a Regen graphic in the Graphics collection, and then modify its properties, position, and other geometrical information to tailor the graphic the way you want. For instance you can create a leader line from a given point with the following code:

Need example

The section entitled "Basic and Regen Graphics in Detail" provides more information on for each of the basic and regen graphic subtypes.


Destroying a Graphic

Graphics can be destroyed by calling the Delete method on the Graphic object. After deleting the Graphic, make sure to set the variable reference to Nothing. Attempting to access any property or method in the Graphic after it has been deleted will result in an error.

Dim gr As Graphic
Set gr = ActiveDrawing.Graphics.Add
gr.Delete
Set gr = Nothing

Graphic.Deleted seems to have no purpose. Hide it? And forget this:

Because TurboCAD's undo engine allows you to undo deletion operations, the Graphic objects still exist in internal memory after you call Graphic.Delete, and your code may still hold references to deleted Graphics (although this is not recommended). You can check whether any of the variables in your code point to Graphics that no longer exist by inspecting the Graphic object's Deleted property.

You can also invoke the Clear method on a graphics collection that owns a number of Graphic objects to destroy all of its contents.


Copying a Graphic

You can make a copy of any graphic using the Duplicate method. The Duplicate method makes a "deep copy" of the graphic, copying all of the graphic's properties, vertices and child graphics. The resultant graphic is placed at the top level of the containing collection, and it and its cloned child graphics receive new Ids.

Note that after using the Duplicate method, there is no link from the newly cloned graphic to the original. If you want to make copies that refer to a master original, the correct way is to make the master a block graphic, and then create block insertions.

The following code demonstrates creating a graphic, duplicating it several times, repositioning the copied graphics, and then modifying the original after the operation is completed.

    Dim gr0 As Graphic
    Dim gr As Graphic
    Dim i As Integer
    Dim x As Double
    Dim y As Double

    'Make a circle centered at 1, 0, 0
    Set gr0 = ActiveDrawing.Graphics.AddCircleCenterAndPoint(1, 0, 0, 0, 0, 0)

    For i = 1 To 5
        'Clone original
        Set gr = gr0.Duplicate

        'Move to clone to point on the unit circle
        x = Cos(i * 3.14159 / 3)
        y = Sin(i * 3.14159 / 3)
        gr.MoveAbsolute x, y, 0
    Next i
    'Modify original -- clones are not affected
    With gr0.Properties
        .Item("BrushStyle") = "Solid"
        .Item("BrushColor") = NamedColors("Red")
    End With

Note: Graphic.LinearCopyXXX, .ArrayCopyXXX, .RadialCopyXXX are to be hidden. Can we write equivalents for these, in VBA, using Duplicate?


Finding the Size of a Graphic: the BoundingBox Object

The SDK provides a BoundingBox object that defines axis-oriented volume in 3D space specified by two diagonal points for the minimum and maximum X, Y, and Z coordinates.

Each graphic object occupies some region of 3D space. You can find out the size of the graphic by using the CalcBoundingBox method of the Graphic. This method returns a BoundingBox object that contains the axis-aligned minimum and maximum points for a volume that encompasses the graphic. The BoundingBox object returned is not owned by the Graphic, but is a copy of the current state of the Graphic. Changing the minimum and maximum points on the BoundingBox will have no effect on the original Graphic.

You can find out the volume of the Graphic for a different coordinate system by supplying a Matrix object as the optional parameter to CalcBoundingBox. The Matrix will be used to temporarily transform the Graphic before doing the bounding box calculation. The transformation is not permanent, and the Graphic object will be in its original position and orientation after the CalcBoundingBox call returns.

Add center and size methods for the BoundingBox object.


Getting the Reference Point of a Graphic

Every Graphic object has a reference point that is used as a basis for performing translation, rotation and scaling operations. The reference point of a Graphic is usually calculated as the center of the Graphic's bounding box, as obtained by the CalcBoundingBox method.

Overriding the reference point.


Moving a Graphic

The Graphic object exposed two methods for moving the graphic from its current location to another.

The Graphic object's MoveRelative method applies a translation operation to the Graphic (and any of its children) according to the X, Y, and Z difference values passed as arguments to it. All the vertices of the graphic and its children are recalculated.

The MoveAbsolute method works with the Graphic object's reference point (usually the center of the graphic's bounding box). MoveAbsolute performs an operation that translates the vertices of the graphics so that after the operation the values of the original reference point's coordinates now will take on the coordinates of the arguments passed to MoveAbsolute. The shape and rotation angle of the Graphic will be unchanged. MoveAbsolute also accepts optional arguments that let you specify the coordinates of a temporary reference point for the move to be used instead of the Graphic's own reference point.

Apparently no way to find out or change (via property) the reference point.

Both MoveRelative and MoveAbsolute return a Matrix object that can be used to replicate the operation. See the topic "Applying Matrix Transformations on a Graphic" for more information.


Rotating a Graphic

The Graphic object's RotateAxis method performs a rotation operation around an axis that you specify. The rotation angle is given in radians, with positive angles meaning a counter-clockwise rotation around the axis (right-hand rule). The three arguments that specify the axis are optional and default to the positive Z axis. The center of rotation is either the Graphic's reference point, or an optional temporary center that you supply as arguments to RotateAxis.

The RotateAbsolute method works with the Graphic object's reference point (usually the center of the graphic's bounding box). You specify the world coordinates of two points: the point to be rotated from, and the point to be rotated to. RotateAbsolute determines the rotation axis by making a cross product of the two vectors that start at the Graphic object's reference point and extend to the two points, calculates the rotation angle between these vectors, and then performs the rotation operation. RotateAbsolute will return an error if the from and to points are collinear with the reference point. RotateAbsolute also accepts optional arguments that let you specify the coordinates of a temporary reference point for the rotation to be used instead of the Graphic's own reference point.

Both RotateAxis and RotateAbsolute return a Matrix object that can be used to replicate the operation. See the topic "Applying Matrix Transformations on a Graphic" for more information.


Scaling a Graphic

You can scale a Graphic object around its reference point (usually the center of the Graphic object's bounding box) or a temporary reference point using the Graphic object's Scale method. You supply scale factors for the X, Y and Z world axes, and an optional temporary reference point for the scaling operation. You can use negative scale factors to perform mirroring operations.

The Scale method returns a Matrix object that can be used to replicate the operation. See the topic "Applying Matrix Transformations on a Graphic" for more information.


Applying Matrix Transformations on a Graphic

In addition to the simple translation, rotation, and scaling operations that the Graphic object supports, you can apply an arbitrary three dimensional affine transformation to a Graphic object through the use of the Graphic object's Transform method. Transform takes a Matrix object as its argument. You can create a Matrix object, set its elements and then pass it to Graphic.Transform to perform the operation:

    Dim gr0 As Graphic
    Dim gr As Graphic
    Dim mtx As Matrix

    Set mtx = New Matrix

    'Set up a pure translation matrix
    'Translation (5, 6, 7)
    mtx.SetEntries _
        1, 0, 0, 0, _
        0, 1, 0, 0, _
        0, 0, 0, 0, _
        5, 6, 7, 1

    Set gr0 = ActiveDrawing.Graphics(0)
    Set gr = gr0.Duplicate
    gr.Transform mtx

The Matrix object is a 4x4 matrix defined in row-major order. You can use the SetEntries method to load the matrix with a list of 16 values, or the SetArray method to load the matrix elements from a one-dimensional Visual Basic array of 16 values, or a two-dimensional 4x4 Visual Basic array. The matrix operates on the three dimensional coordinate system, so the fourth column of values are ignored.


Reshaping Graphic Geometry

Many times you will want to reshape an existing graphic. The most direct way to do this is by modifying the coordinates and number of the vertices that define the graphic, and the properties that control other aspects of the graphic. By reading the documentation on the different graphic subtypes, you can understand the rules for reshaping each type.

Need example


Exploding a Graphic

TurboCAD's user interface includes a utility feature called "Explode" that allows you to break up complex graphic types into simpler pieces. Depending on the type of graphic operated on, the explode operation will produce different results:

Groups are exploded by removing their children from the group, and making them top-level graphics.

Curves, arcs and circles are exploded by converting them to polyline approximations.

Text graphics are exploded by converting them to curves.

Regen graphics have explosion results that vary according to the particular type.


Changing the Drawing Order of a Graphic

If you are working with opaque, two dimensional graphics, you often need to control the order in which graphics are drawn, since graphics drawn later may obscure those drawn previously. You can use the BringToFront method of the Graphic object to move a graphic to the last place in the drawing list, so that it appears "on top" of all the other graphics, or the SendToBack method to move a graphic to the first place in the list, so that it appears "behind" all of the other graphics.

Graphic.ZOrder is unimplemented.


Making Changes to Graphics Undoable

The TurboCAD user interface supports multiple levels of undo through the use of a stack of undo records. When you make changes to the contents of a drawing by creating, destroying or modifying graphics, you should support the ability to undo these changes by using the undo facilities of the SDK.

The UndoRecord object represents a single undoable action in the user interface. The UndoRecord supports the following methods:

UndoRecord Methods
Method | Description
AddGraphic | Add a reference to a newly created Graphic object.
AddGraphicForModify | Add a reference to a Graphic that has been modified.
DeleteGraphic | Add a reference to a Graphic object that is about to be destroyed.
Close | Signal that the current undoable action has been completed, and place the complete undo record on the undo stack.
Delete | Abort the current undoable action. Do not place the undo record on the undo stack.

Many times you will make several changes to the contents of a drawing, creating new graphics and modifying existing graphics as part of an atomic operation. For example you could build a number of graphics to represent a physical part. You could enable the undoing the operation of adding all the graphics representing the part at one time, rather than forcing the user to undo the addition of each graphic. How you structure what is an undoable operation is up to you.


Setting up an Undo Record

Before making an undoable change to one or more graphics, you create an active UndoRecord object by calling the Drawing object's AddUndoRecord method, supplying the text that you want to appear in the Undo menu item.

Dim urec As UndoRecord
Set urec = ActiveDrawing.AddUndoRecord("Add Part")

After the call to AddUndoRecord, you can proceed to create, destroy or modify graphics. The new undo record will not appear in the user interface until it has been completed by another SDK call.


Adding References to the Undo Record

For each graphic that is created, destroyed or modified as part of an undoable action, you must add a reference to the graphic to the undo record that you have set up. The UndoRecord object exposes a method for each of the three actions: create, destroy and modify. When you are adding a new graphic to the drawing as part of an undoable action, you record the addition by using the AddGraphic method:

Dim grNew As Graphic
Set grNew = ActiveDrawing.AddSquare
urec.AddGraphic grNew

If you are just modifying anything (position, color, etc.) in a graphic that already exists as a top-level graphic in the drawing, you record the graphic by using the AddGraphicForModify method. You should only call this method once for each graphic, even though you may make many modifications to the graphic:

Dim grModified As Graphic
Set grModified = ActiveDrawing.Graphics(0)
grModified.Properties("PenColor") = NamedColors("Blue")
grModified.Vertices(0).X = 3
urec.AddGraphicForModify grModified

If you are destroying existing graphics as part of your undoable action, you must add a reference to the graphic to the current undo record before you destroy the graphic, calling the DeleteGraphic method:

Dim grToDestroy As Graphic
Set grToDestroy = ActiveDrawing.Graphics(1)
urec.DeleteGraphic grToDestroy
grToDestroy.Delete
Set grToDestroy = Nothing


Completing or Aborting the Undo Record

When all the changes to the drawing's contents that are part of the undoable action have been finished, you call the Close method of the UndoRecord object to finalize the action and place the undo record on the stack, enabling it in the user interface:

urec.Close
Set urec = Nothing

If there are errors encountered during your undoable action, and you don't want the action to be placed on the undo stack, you use the UndoRecord's Delete method:

urec.Delete
Set urec = Nothing

NOTE If you must abort an undoable action, it is up to you, the programmer, to clean up and restore the contents of the drawing as well as call the UndoRecord Delete method. Take care to Close or Delete every UndoRecord that is created by the AddUndoRecord call. Since UndoRecords are placed on a stack, failure to Close or Delete the active undo record may result in a crash.


Hit Testing a Graphic in 3D Space

Given an arbitrary point in world coordinates, you can find the distance from the closest part of a graphic to the point by using the GetDistance method of the Graphic object. The GetDistance method returns three values: a Vertex object that contains the coordinates of the closest part of the graphic to the given point, a Graphic object that is either the graphic itself or one of its descendants that contains that closest part, and a distance amount from the closest part to the point.

Using the GetDistance method, you can iterate over a collection of graphics to find out which one is closest to a given point.


Basic and Regen Graphics in Detail

ExtendedSelInfo sample to be used to probe graphics

Are there other types that you don't see on this page? I guess I could look at TC rendering or filter source code…

Bitmaps? OleObjects?

Should have Addxxx example for each section.

Should have summary of common and per-subtype properties for each section.


Using 3D Polyline Graphics (Basic)

3D Polylines are defined by the basic GRAPHIC type, with a list of vertices that specify. When you use the Line, 3D Polyline, and Sketch tools, these are the graphics that you create.

What all the vertices mean, creating, modifying, edit node, etc…

The simplest type of visible graphic you can create is a line.

Example: ActiveDrawing.Graphics.AddLine, followed by Extended Sel Info

3D Polyline Graphic Details
Part | Description
Type | GRAPHIC
RegenType | (not available)
Normal Flags | BuiltIn, Editable, Visible
Subtype Extended Properties | (none)

All vertices in a 3D Polyline have the same flags. PenUp and PenDown flags can control the visibility of the stroke from one vertex to the next.

3D Polyline Graphic Vertices
Vertex Index | Description
0 to N-1 | Flags: PenDown or PenUp, Editable, Linkable, Snappable, Selectable X, Y, Z: Start or end point of line segment Bulge: False


Using Polygon Graphics (Basic)

Polygons are also just simple objects of type "GRAPHIC". There are two things that set these apart from 3D Polylines: the vertex coordinates must be coplanar, and the the Graphic object must have the Closed standard property set to True. Polygon Graphics are created when you use the Regular Polygon, Irregular Polygon, Rectangle, Rotated Rectangle or Hatch tools in the TurboCAD user interface.

Polygon Graphic Details
Part | Description
Type | GRAPHIC
RegenType | (not available)
Normal Flags | BuiltIn, Closed, Editable, Visible
Subtype Extended Properties | (none)

For a polygon with N sides, TurboCAD actually builds N+1 vertices. Vertex 0 and vertex N must have the same coordinates:

Polygon Graphic Vertices
Vertex Index | Description
0 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Start point of line segment Bulge: False
1 to N-1 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: End point of line segment Bulge: False
N | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: End point of line segment (must be the same as vertex 0) Bulge: False


Using Construction Line Graphics (Basic)

Construction lines are defined as two-vertex GRAPHIC types, with some additional restrictions: The Graphic's Unbounded flag must be set to True, and the Graphic must reside on a predefined layer named "$CONSTRUCTION".

Construction Line Graphic Details
Part | Description
Type | GRAPHIC
RegenType | (not available)
Normal Flags | BuiltIn, Editable, Visible, Unbounded
Subtype Extended Properties | Layer = "$CONSTRUCTION"

Both vertices in a construction line have the same flags.

Construction Line Graphic Vertices
Vertex Index | Description
0, 1 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Arbitrary points on construction line Bulge: False


Using 2D Polyline Graphics (Regen)

2D Polylines can contain linear or circular arc segments, and are handled by a Regen that builds an approximating curve. 3D Polylines do not allow these "bulge" arc segments.

2D Polyline Graphic Details
Part | Description
Type | TCW50Polyline
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

The following table shows an example of a polyline with three segments: a line segment from vertex 0 to vertex 1, an arc segment from vertices 1 to 4, and another line segment from vertex 4 to 5. Note that for each arc segment in a polyline, two vertices with the Bulge flag are added. The first Bulge vertex is the center point of the arc, and the second Bulge vertex is a control point on the arc, which indicates the direction of the arc.

2D Polyline Graphic Vertices
Vertex Index | Description
0 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Start point of line segment Bulge: False
1 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: End point of line segment Bulge: False
2 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Center point of arc segment Bulge: True
3 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Control point on arc segment Bulge: True
4 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: End point of arc segment Bulge: False
5 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: End point of arc segment Bulge: False

In addition, if there are any arc segments in the polyline, a single cosmetic child graphic will be created that is a continuous approximation polyline with arc segments approximated by a subdivision into straight line segments:

2D Polyline Cosmetic Child Graphic
Part | Description
Type | GRAPHIC
RegenType | (not available)
Normal Flags | BuiltIn, Cosmetic, Editable, Visible
Subtype Extended Properties | (none)

All cosmetic child vertices have the same flags.

2D Polyline Cosmetic Child Vertices
Vertex Index | Description
0 to N | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Start or end point of line segment Bulge: False


Specifying Arc Segments in a Polyline

show example of changing the bulge in a polyline


Using Point Graphics (Regen)

Point Graphic Details
Part | Description
Type | TCW30Point
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

The point graphic subtype has one PenUp vertex, located at the center of the point symbol:

Point Graphic Vertices
Vertex Index | Description
0 | Flags: PenUp, Editable, Linkable, Snappable, Selectable X, Y, Z: Start point of line segment Bulge: False

All point subtypes generate 2 child graphics: a DATA graphic that stores property information, and a cosmetic graphic that renders the outline or symbol.

The Star, Square, and Circle point subtypes' cosmetic graphic is a polygon. The Dot and Cross point subtypes generate

Cosmetic Child Graphic
Part | Description
Type | GRAPHIC
RegenType | (not available)
Normal Flags | BuiltIn, Cosmetic, Editable, Visible Closed for Star, Square, and Circle
Subtype Extended Properties | (none)

For the Star, Square and Circle point subtypes, the cosmetic child vertices define a polygon.

Star, Square and Circle Cosmetic Child Vertices
Vertex Index | Description
0 | Flags: PenUp, Selectable X, Y, Z: Start of line segment Bulge: False
1 to N-1 | Flags: PenDown, Selectable X, Y, Z: End point of line segment Bulge: False
N | Flags: PenDown, Selectable X, Y, Z: End point of line segment (must be same as vertex 0) Bulge: False

For the Dot and Cross point subtypes, the cosmetic child vertices define a series of PenUp-PenDown line segments. The Dot subtype generates two vertices at the same location.

Dot and Cross Cosmetic Child 0 Vertices
Vertex Index | Description
0 | Flags: PenUp, Selectable X, Y, Z: Start of line segment Bulge: False
1 | Flags: PenDown, Selectable X, Y, Z: End point of line segment (for Dot: the same as vertex 0) Bulge: False
2 (Cross only) | Flags: PenUp, Selectable X, Y, Z: Start of line segment Bulge: False
3 (Cross only) | Flags: PenDown, Selectable X, Y, Z: End point of line segment Bulge: False


Using Circular Arc, Circle, Elliptical Arc, and Ellipse Graphics (Basic)

Arc, Circle and Ellipse Graphic Details
Part | Description
Type | ARC (for circular or elliptical arc) CIRCLE (for circle or ellipse)
RegenType | (not available)
Normal Flags | BuiltIn, Editable, Visible (for circle or ellipse: also Closed)
Subtype Extended Properties | (none)

An arc, circle or ellipse is defined by exactly 4 vertices:

Arc, Circle and Ellipse Graphic Vertices
Vertex Index | Description
0 | Flags: PenDown, Editable, Snappable, Selectable X, Y, Z: Center of arc, circle or ellipse Bulge: False
1 | Flags: PenDown, Editable, Snappable, Selectable X, Y, Z: Start point of arc or circle (for ellipse: point on major axis) Bulge: False
2 | Flags: PenDown, Editable, Snappable, Selectable X, Y, Z: End point of arc or circle (for circle or ellipse: same as vertex 1) Bulge: False
3 | Flags: PenDown, Editable, Snappable, Selectable X, Y, Z: Intermediate point on arc (for arc: arbitrary point to determine arc direction and major/minor ratio) (for circle: quadrant point) (for ellipse: point on minor axis) Bulge: False


Getting Arc Information

Since Arc, Circle and Ellipse Graphics are described by four vertices on the graphic, the SDK provides a convenience method that allows you to get their geometric properties. The Graphic object's GetArcData takes an array of 10 Doubles that you declare as:

Dim arcData(0 To 9) As Double

GetArcData fills the array with the following information:

GetArcData Array
Array Index | Description
0, 1, 2 | X, Y and Z coordinates of arc center
3, 4, 5 | X, Y and Z coordinates of point on arc major axis
6 | Ratio of minor to major axis
7 | Start angle of arc in radians
8 | End angle of arc in radians
9 | 1 if arc is closed, 0 otherwise


Using Construction Circle Graphics (Basic)

Construction circles are just CIRCLE graphics that are constrained to the "$CONSTRUCTION" layer and have the Unbounded flag set to True.

Construction Circle Graphic Details
Part | Description
Type | CIRCLE
RegenType | (not available)
Normal Flags | BuiltIn, Closed, Editable, Visible, Unbounded
Subtype Extended Properties | LAYER = "$CONSTRUCTION"

The vertices for a construction circle graphic are identical to a non-construction circle.


Using Text Graphics (Regen)

Text Graphic Details
Part | Description
Type | TEXT
RegenType | (not available)
Normal Flags | Editable, Visible
Text Graphic Extended Properties
Property | Description
TextMode | Enum: 1 - Standard Text, 2 - Scalable Text, 3 - Flexible Text
Obliquity | Slant angle in degrees for Flexible Text

A text graphic is defined by exactly 6 vertices:

Text Graphic Vertices
Vertex Index | Description
0 | Flags: PenUp X, Y, Z: Justification reference point (i.e. determined by justification settings-left, center, right, top, middle, baseline, bottom) Bulge: False
1 | Flags: PenUp, Linkable, Selectable X, Y, Z: Cell spacing start point (usually at top left of cell rectangle) Bulge: False
2 | Flags: PenDown, Linkable, Selectable X, Y, Z: Bottom left of cell rectangle Bulge: False
3 | Flags: PenDown, Linkable, Selectable X, Y, Z: Bottom right of cell rectangle Bulge: False
4 | Flags: PenDown, Linkable, Selectable X, Y, Z: Top right of cell rectangle Bulge: False
5 | Flags: PenDown, Linkable, Selectable X, Y, Z: Top left of cell rectangle Bulge: False

Note that for flexible text only, there is a single cosmetic graphic which is a sequence of approximating line segments:

Flexible Text Cosmetic Child Graphic
Part | Description
Type | GRAPHIC
RegenType | (not available)
Normal Flags | BuiltIn, Closed, Cosmetic, Editable, Visible
Subtype Extended Properties | (none)

Flexible Text Cosmetic Child Vertices
Vertex Index | Description
0 | Flags: PenUp, Editable, Linkable, Snappable, Selectable X, Y, Z: Start of line segment Bulge: False
1 to N | Flags: PenUp or PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Start or End point of line segment Bulge: False


Using Double Line Graphics (Regen)

A Double Line graphic is much like a simple GRAPHIC polyline, except that the coordinate vertices specify an invisible definition polyline. The actual parallel, drawn line segments are in a single, closed cosmetic child graphic. The Closed flags on the parent graphic is set to True if the double line is a closed polygon (for example, created with the Double Polygon, Double Irregular Polygon, Double Rectangle or Double Rotated Rectangle tools). The rules for double polygons are the same as for single line polygons: the last vertex must be coincident with the first vertex.

Double Line Graphic Details
Part | Description
Type | TCW25DblLine
RegenType | (not available)
Normal Flags | Editable, Visible (for double polygons: also Closed)
Subtype Extended Properties | (none)

A double line graphic is defined by at least 2 vertices:

Double Line Graphic Vertices
Vertex Index | Description
0 to N-1 | Flags: PenUp, Editable, Snappable, Selectable X, Y, Z: Double line definition polyline point Bulge: False

Double lines have 2 children: a DATA graphic and a cosmetic GRAPHIC. Note that the single cosmetic graphic is always flagged as Closed, and that the visibility of its line segments is controlled by the PenUp/PenDown flags on the individual vertices:

Double Line Cosmetic Child Graphic Details
Part | Description
Type | GRAPHIC
RegenType | (not available)
Normal Flags | BuiltIn, Closed, Editable, Visible, Cosmetic
Subtype Extended Properties | (none)

A double line graphic is defined by at least 2 vertices:

Double Line Cosmetic Child Graphic Vertices
Vertex Index | Description
0 to N-1 | Flags: PenUp or PenDown, Linkable, Snappable, Selectable X, Y, Z: Point on the closed polygon that is drawn. PenUp/PenDown flag controls whether a particular segment is drawn or not Bulge: False


Using Multiline Graphics (Regen)

A Multiline graphic is similar to a simple GRAPHIC polyline, except that the coordinate vertices are specify an invisible definition polyline. The actual parallel, drawn line segments are contained in several cosmetic child graphics, one for each trace of the multiline. The Closed flags on the parent and child graphics are set to True if the multiline is a closed polygon (for example, created with the Multiline Polygon, Multiline Irregular Polygon, Multiline Rectangle, or Multiline Rotated Rectangle tools). The rules for multiline polygons are the same as for single line polygons: the last vertex must be coincident with the first vertex.

Multiline Graphic Details
Part | Description
Type | TC_Multiline
RegenType | (not available)
Normal Flags | Editable, Visible (for polygons: also Closed)
Subtype Extended Properties | (none)

A multiline graphic is defined by at least 2 vertices:

Multiline Graphic Vertices
Vertex Index | Description
0 to N-1 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Multiline definition polyline point Bulge: False

Multilines have a child DATA graphic that contains the properties, and one cosmetic GRAPHIC for each trace of the multilane. A triple line, for example, will have the DATA graphic and 3 child cosmetic GRAPHICs.

Multiline Cosmetic Child Graphic Details
Part | Description
Type | GRAPHIC
RegenType | (not available)
Normal Flags | BuiltIn, Editable, Visible, Cosmetic (for polygons: also Closed)
Subtype Extended Properties | (none)

The multline cosmetic graphic is defined by at least 2 vertices:

Multiline Cosmetic Child Graphic Vertices
Vertex Index | Description
0 to N-1 | Flags: PenUp or PenDown, Linkable, Snappable, Selectable X, Y, Z: Point on the polyline or polygon that is drawn. PenUp/PenDown flag controls whether a particular segment is drawn or not Bulge: False


Using Spline Curve Graphics (Regen)

The TurboCAD Spline curve is a continous cubic spline, defined by a minimum of three control points. Each Spline is defined by start and end points on the curve, and at least one intermediate control point. All intermediate control points are off-curve points.

The parent Spline curve graphic has two children: a DATA graphic that contains property information, and a cosmetic GRAPHIC that contains the approximating polyline to the curve. The child cosmetic is just a simple 3D Polyline type.

Spline Curve Graphic Details
Part | Description
Type | TCW30CURVE
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

A curve graphic is defined by at least 3 vertices:

Spline Curve Graphic Vertices
Vertex Index | Description
0 | Flags: PenUp, Editable, Snappable X, Y, Z: On-curve point at start of curve Bulge: False
1 to N-2 | Flags: PenUp, Editable X, Y, Z: Off-curve control point Bulge: False
N-1 | Flags: PenUp, Editable, Snappable X, Y, Z: On-curve point at end of curve Bulge: False


Using Bezier Curve Graphics (Regen)

The Bezier curve is a piecewise cubic curve, in which each piece is defined by four control points, a start and end point on the curve, and two intermediate off-curve control points. Therefore, the shortest Bezier curve has four vertices, one with two connected pieces has seven vertices (since the middle on-curve control point is shared between both pieces), etc.

The parent Bezier curve graphic has two children: a DATA graphic that contains property information, and a cosmetic GRAPHIC that contains the approximating polyline to the curve.

Bezier Curve Graphic Details
Part | Description
Type | TCW30CURVE
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

A curve graphic is defined by at least 4 vertices:

Spline Curve Graphic Vertices
Vertex Index | Description
0 | Flags: PenUp, Editable, Snappable X, Y, Z: On-curve point at start of curve Bulge: False
1, 4, … | Flags: PenUp, Calculated, Editable X, Y, Z: Off-curve control point (tied to previous on-curve point) Bulge: False
2, 5, … | Flags: PenUp, Calculated, Editable X, Y, Z: Off-curve control point (tied to next on-curve point) Bulge: False
3, 6, … | Flags: PenUp, Editable X, Y, Z: On-curve point Bulge: False
N-1 | Flags: PenUp, Editable, Snappable X, Y, Z: On-curve point at end of curve Bulge: False

The curve graphic has two children: a DATA graphic that contains property information, and a cosmetic GRAPHIC that contains the approximating polyline to the curve.


About Dimension and Leader Graphics

Dimensions and leaders all use the same basic mechanism to define and draw themselves. They combine polylines, arrowheads and text.

Add more examples here.


Using Linear Dimension Graphics (Regen)

The Linear Dimension regen also handles Baseline, Continuous and Incremental types of dimensions.

Linear Dimension Graphic Details
Part | Description
Type | TCW25DimLin
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

A linear dimension graphic is defined by exactly 6 vertices:

Linear Dimension Graphic Vertices
Vertex Index | Description
0 | Flags: PenUp X, Y, Z: Origin Bulge: False
1 | Flags: PenUp, Editable, Linkable X, Y, Z: Virtual point on first extension line Bulge: False
2 | Flags: PenUp, Editable, Linkable X, Y, Z: Virtual point on second extension line Bulge: False
3 | Flags: PenUp, Editable X, Y, Z: Intersection of first extension line with dimension string line Bulge: False
4 | Flags: PenUp, Editable, Selectable X, Y, Z: Actual location of dimension text Bulge: False
5 | Flags: PenUp X, Y, Z: Original location of dimension text Bulge: False

The linear dimension graphic has 10 child graphics: a DATA graphic containing the properties, 2 GRAPHIC extension lines, 2 GRAPHIC polyline cosmetic children that draw each half of the dimension line, 2 GRAPHIC arrowhead cosmetic children, and 3 TEXT cosmetic children for the parts of the dimension text: number, tolerance and units.


Using Angular Dimension Graphics (Regen)

Angular Dimension Graphic Details
Part | Description
Type | TCW25DimAng
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

An angular dimension graphic is defined by exactly 6 vertices:

Angular Dimension Graphic Vertices
Vertex Index | Description
0 | Flags: PenUp, Editable, Linkable X, Y, Z: Center of arc or circle Bulge: False
1 | Flags: PenUp, Editable, Linkable X, Y, Z: Virtual point on first extension line Bulge: False
2 | Flags: PenUp, Editable, Linkable X, Y, Z: Virtual point on second extension line Bulge: False
3 | Flags: PenUp, Editable X, Y, Z: Arbitrary point on dimension arc Bulge: False
4 | Flags: PenUp, Editable, Selectable X, Y, Z: Actual location of dimension text Bulge: False
5 | Flags: PenUp X, Y, Z: Original location of dimension text Bulge: False

The angular dimension graphic has 10 child graphics: a DATA graphic containing the properties, 2 GRAPHIC extension lines, 2 ARC cosmetic children that draw each half of the dimension arc, 2 GRAPHIC arrowhead cosmetic children, and 3 TEXT cosmetic children for the parts of the dimension text: number, tolerance and units.


Using Radial and Diameter Dimension Graphics (Regen)

Radial Dimension Graphic Details
Part | Description
Type | TCW25DimRad (radial) or TCW25DimDia (diameter)
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

A radial dimension graphic is defined by exactly 5 vertices:

Radial Dimension Graphic Vertices
Vertex Index | Description
0 | Flags: PenUp, Linkable, Selectable X, Y, Z: Center of arc or circle Bulge: False
1 | Flags: PenUp, Editable, Linkable, Selectable X, Y, Z: Intersection of radial line with arc or circle Bulge: False
2 | Flags: PenUp, Editable, Snappable, Selectable X, Y, Z: End of radial line Bulge: False
3 | Flags: PenUp X, Y, Z: Original location of dimension text Bulge: False
4 | Flags: PenUp, Editable, Snappable, Selectable X, Y, Z: Actual location of dimension text Bulge: False

The radial dimension graphic has 8 child graphics: a DATA graphic containing the properties, 1 GRAPHIC cosmetic child that draws the interior, exterior and leader parts, 2 GRAPHIC arrowhead cosmetic children (one of which can be degenerate for the radial dimension), 1 GRAPHIC cosmetic child that draws the center point, and 3 TEXT cosmetic children for the parts of the dimension text: number, tolerance and units.


Using Datum Dimension Graphics (Regen)

Datum Dimension Graphic Details
Part | Description
Type | TCW25DimDat
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

A datum dimension graphic is defined by exactly 3 vertices:

Datum Dimension Graphic Vertices
Vertex Index | Description
0 | Flags: PenUp, Linkable X, Y, Z: Origin Bulge: False
1 | Flags: PenUp, Editable, Linkable X, Y, Z: Virtual point: datum point Bulge: False
2 | Flags: PenUp, Editable, Linkable X, Y, Z: Virtual point: text line Bulge: False

The datum dimension graphic has 6 child graphics: a DATA graphic containing the properties, 2 GRAPHIC cosmetic children that define the datum polyline and arrow head, and 3 TEXT cosmetic children for the parts of the dimension text: number, tolerance and units.


Using Leader Graphics (Regen)

Leader Graphic Details
Part | Description
Type | TCW25DimLead
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

A leader is defined by two vertices that locate the leader text, followed by N-3 vertices that define the leader polyline:

Leader Graphic Vertices
Vertex Index | Description
0 | Flags: PenUp, Editable X, Y, Z: Origin (text) Bulge: False
1 | Flags: PenUp X, Y, Z: Origin (text) Bulge: False
2 | Flags: PenUp, Editable, Linkable X, Y, Z: Start point of leader line (arrowhead location) Bulge: False
3 to N-1 | Flags: PenUp, Editable X, Y, Z: Start and end points of leader line segments Bulge: False

The leader graphic has 4 child graphics: a DATA graphic containing the properties, one GRAPHIC cosmetic child that defines the leader polyline, one GRAPHIC cosmetic child that draws the arrow head, and the TEXT cosmetic child that draws the leader text.


Using Wall Graphics (Regen)

Wall graphics are a 2D type that has additional intelligence. Walls are built up from linked segments, each of which is defined by a single top-level Wall graphic.

To be continued; I have no idea of how these work…

Wall Graphic Details
Part | Description
Type | TCW60Wall
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

Each wall graphic (segment) is defined by exactly 2 vertices:

Wall Graphic Vertices
Vertex Index | Description
0 | Flags: PenUp, Editable, Snappable, Selectable X, Y, Z: First definition point for wall Bulge: False
1 | Flags: PenUp, Editable, Snappable, Selectable X, Y, Z: Second definition point for wall Bulge: False

The parent Wall graphic has at least three children, a DATA graphic containing the Wall segment properties, one or more non-cosmetic GRAPHIC named "Gap" that define how the Wall graphic intersects other wall graphics, and a cosmetic child that draws the result.

Wall Gap Non-Cosmetic Child Graphic
Part | Description
Type | GRAPHIC
RegenType | (not available)
Normal Flags | BuiltIn, Closed, Cosmetic, Editable, Visible
Subtype Extended Properties | Name = "Gap"

Gap graphics always contain exactly five vertices:

Need info on these.

Wall Gap Non-Cosmetic Child Vertices
Vertex Index | Description
0 | Flags: PenUp X, Y, Z: Start of line segment Bulge: False
1 | Flags: PenDown X, Y, Z: Start of line segment Bulge: False
2 | Flags: PenUp X, Y, Z: Start of line segment Bulge: False
3 | Flags: PenDown X, Y, Z: Start of line segment Bulge: False
4 | Flags: PenUp X, Y, Z: Start of line segment Bulge: False

In addition wall segments that are part of a continuously drawn wall can have non-cosmetic GRAPHICs named "Start" and "End" (0 or one Start GRAPHICs and 0 or one End Graphics may be present). These children define the starting and ending points for the two faces of the wall.

Wall Start or End Non-Cosmetic Child Graphic
Part | Description
Type | GRAPHIC
RegenType | (not available)
Normal Flags | BuiltIn, Closed, Cosmetic, Editable, Visible
Subtype Extended Properties Name = "Start" for start graphic
Name = "End" for end graphic

Start or End graphics always contain exactly two vertices:

Wall Start or End Non-Cosmetic Child Vertices
Vertex Index | Description
0 | Flags: PenUp X, Y, Z: Start or end of one wall face Bulge: False
1 | Flags: PenUp X, Y, Z: Start or end of other wall face Bulge: False


About Surface Graphics

3D solids and surfaces in TurboCAD can be defined as a polygonal mesh or using the ACIS geometry engine. The Surface graphic type represents the polygonal mesh representation.

Surface Graphic Details
Part | Description
Type | SURFACE
RegenType | (not available)
Normal Flags | Builtin, Editable, Visible
Subtype Extended Properties | (none)

Vertices for the mesh are all specified the same way. The internal properties of the SURFACE graphic describe how the mesh vertices are connected.

Surface Graphic Vertices
Vertex Index | Description
0 to N-1 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Vertex of the surface mesh Bulge: False

To change the topology of the mesh that defines the Surface graphic (by inserting or removing vertices and edges), you must access the mesh-defining properties through an object model.

Discuss use of Edges, Contours.


Getting Mesh Face Data

Two convenience methods in the Graphic object provide access to the topology of SURFACE and 3DMESH graphic types.

GetFaceDimension

You can use the GetFaceDimension method of the Graphic object to obtain the overall size of the mesh. GetFaceDimension fills its M and N arguments with the rectangular size of the 3DMESH (number of rows and columns in the mesh), and its facetCount argument with the number of faces of the SURFACE or 3DMESH graphic.

GetFaceData

You can use the GetFaceData method of the Graphic object to obtain information on the mesh that defines a SURFACE or 3DMESH graphic type. You supply three undimensioned arrays to GetFaceData, dimensioned as follows:

Dim vtxCoords() As Double 'vertex coordinate array
Dim vtxIndices() As Long 'face vertex index array
Dim edgeFlags() As Long 'face edge flag array

After GetFaceData returns, these arrays will be filled with the mesh topology. Each array will be resized to hold the data. The vertex coordinates array will contain the X, Y, and Z coordinates of the vertices that define the surface or 3D mesh. The face vertex index array will contain a sequence of indices into the vertex coordinate array that define all the faces of the surface or mesh. Each face is defined by a sequence of non-negative index values (3 or 4 depending on the type of mesh), followed by a -1 value indicating the closure of the face. The index values are coordinate indices; they must be multiplied by three to obtain the actual index to be used for the vertex coordinate array, which consists of triplets of X, Y, and Z values. The face edge flag array can be read in parallel with the face vertex index array. Each value in the array is either 0 or 1, 1 representing a visible edge, and 0 representing an invisible edge.

Show example of use


About ACIS Solid Graphics

3D solids and surfaces in TurboCAD can be defined as a polygonal mesh or using the ACIS geometry engine. ACIS provides a very high level of geometrical precision to mathematically define a variety of 3D solid types. ACIS solids are created as cosmetic children when you construct any of the basic TurboCAD 3D solid graphics (Box, Prism, Polygonal Prism, Sphere, Hemisphere, Cylinder, Cone, Torus, Extrusion, Revolution, Wedge, 3D Mesh). They are also created as top-level graphic objects when you use any of the 3D Boolean tools.

When you use one of the 3D solid creation tools, you will create a graphics hierarchy that looks something like this:

Insert figure here.

The DATA graphic at the child level contain data specific for each type of solid. The DATA graphic at the grandchild level contains data used by the ACIS engine, including the geometry definition. The ACIS Solid child graphic has no vertices itself, since it is defined completely by the grandchild DATA graphic's information. However, to allow for display, the ACIS Solid regen tessellates its geometry into a SURFACE graphic. This polygonal mesh graphic is what is used to approximate the geometry for the purposes of rendering materials.

When you use one of the 3D Boolean operations, your hierarchy will look like this:

Insert figure here.


Using 3D Box Graphics (Regen)

Box Graphic Details
Part | Description
Type | TCW40CUBE
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

A box graphic is defined by exactly 4 vertices:

Box Graphic Vertices
Vertex Index | Description
0 | Flags: PenUp, Linkable, Snappable, Selectable X, Y, Z: Origin of box (one corner) Bulge: False
1 | Flags: PenUp, Linkable, Snappable, Selectable X, Y, Z: First axis of box base Bulge: False
2 | Flags: PenUp, Linkable, Snappable, Selectable X, Y, Z: Second axis of box base Bulge: False
3 | Flags: PenUp, Linkable, Snappable, Selectable X, Y, Z: Third axis of box (Z axis) Bulge: False

A box graphic has two direct child graphics, a DATA graphic that holds the box properties, and a TCW60ACISSOLID cosmetic graphic:

Box ACIS Solid Cosmetic Child Graphic
Part | Description
Type | TCW60ACISSOLID
RegenType | (not available)
Normal Flags | Cosmetic, Editable, Visible
Subtype Extended Properties | (none)

The ACIS Solid has no vertices itself, but has two children (grandchildren of the original box graphic): a DATA graphic that holds ACIS information and a SURFACE cosmetic graphic:

Box ACIS Solid Surface Cosmetic Child Graphic
Part | Description
Type | SURFACE
RegenType | (not available)
Normal Flags | Builtin, Cosmetic, Editable, Visible
Subtype Extended Properties | (none)

The surface has 24 vertices that describe the faces of the box:

Box ACIS Solid Surface Cosmetic Child Vertices
Vertex Index | Description
0 to 23 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Vertex of box face. Coordinates are defined relative to the center of the box. Bulge: False


Using 3D Sphere Graphics (Regen)

Sphere graphics are created using the Sphere and Hemisphere tools.

Sphere Graphic Details
Part | Description
Type | TCW40SPHERE
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

A sphere graphic is defined by exactly 2 vertices:

Sphere Graphic Vertices
Vertex Index | Description
0 | Flags: PenUp, Editable, Linkable, Snappable, Selectable X, Y, Z: Center of sphere Bulge: False
1 | Flags: PenUp, Editable, Linkable, Snappable, Selectable X, Y, Z: Point on sphere (Z axis) Bulge: False

A sphere graphic has two direct child graphics, a DATA graphic that holds the sphere properties, and a TCW60ACISSOLID cosmetic graphic:

Sphere ACIS Solid Cosmetic Child Graphic
Part | Description
Type | TCW60ACISSOLID
RegenType | (not available)
Normal Flags | Cosmetic, Editable, Visible
Subtype Extended Properties | (none)

The ACIS Solid has no vertices itself, but has two children (grandchildren of the original sphere graphic): a DATA graphic that holds ACIS information and a SURFACE cosmetic graphic:

Sphere ACIS Solid Surface Cosmetic Child Graphic
Part | Description
Type | SURFACE
RegenType | (not available)
Normal Flags | Builtin, Cosmetic, Editable, Visible
Subtype Extended Properties | (none)

The surface has vertices that describe the faces of the sphere's tessellation. The number of these vertices varies depending on the longitudinal/latitudinal section properties:

Sphere ACIS Solid Surface Cosmetic Child Vertices
Vertex Index | Description
0 to N-1 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Vertex of sphere face. Coordinates are defined relative to the center of the sphere. Bulge: False


Using 3D Extrude Graphics (Regen)

Extrude graphics are created when you use the Extrude, Cylinder, or Wedge tools in the TurboCAD user interface.

Extrude Graphic Details
Part | Description
Type | TCW40EXTRUDE
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

An extrude graphic is defined by three or more vertices. The first two vertices define the starting point and plane of the base. Each successive vertex defines a segment of the extrusion process:

Extrude Graphic Vertices
Vertex Index | Description
0 | Flags: PenUp, Linkable, Snappable, Selectable X, Y, Z: Origin of extrusion Bulge: False
1 | Flags: PenUp, Linkable, Snappable, Selectable X, Y, Z: Base axis Bulge: False
2 to N-1 | Flags: PenUp, Linkable, Snappable, Selectable X, Y, Z: Segment axis Bulge: False

An extrude graphic has three direct child graphics, a DATA graphic that holds the extrude properties, a child non-cosmetic GRAPHIC that defines the polgyon path that is extruded, and a TCW60ACISSOLID cosmetic graphic:

Extrude Polygon Non-Cosmetic Child Graphic
Part | Description
Type | GRAPHIC
RegenType | (not available)
Normal Flags | BuiltIn. Closed Editable, Visible
Subtype Extended Properties | (none)

See information on polygons for the definition of this child's vertices.

Extrude ACIS Solid Cosmetic Child Graphic
Part | Description
Type | TCW60ACISSOLID
RegenType | (not available)
Normal Flags | Cosmetic, Editable, Visible
Subtype Extended Properties | (none)

The ACIS Solid has no vertices itself, but has two children (grandchildren of the original extrude graphic): a DATA graphic that holds ACIS information and a SURFACE cosmetic graphic:

Extrude ACIS Solid Surface Cosmetic Child Graphic
Part | Description
Type | SURFACE
RegenType | (not available)
Normal Flags | Builtin, Cosmetic, Editable, Visible
Subtype Extended Properties | (none)

The surface has vertices that describe the faces of the extrusion's tessellation. The number of these vertices varies depending on the geometry of the extrusion:

Extrude ACIS Solid Surface Cosmetic Child Vertices
Vertex Index | Description
0 to N-1 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Vertex of sphere face. Coordinates are defined relative to the center of the sphere. Bulge: False


Using 3D Revolution Graphics (Regen)

Solids and surfaces of revolution are geometries defined by taking a 2D polyline or polygon and rotating it about an axis. Revolutions are created when you use the Revolve or Torus tools in TurboCAD. The parent revolution graphic specifies the center and axis of rotation. The revolved geometry is defined by a non-cosmetic child graphic.

Revolution Graphic Details
Part | Description
Type | TCW40SPIN
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

The revolution parent graphic contains exactly two vertices that define the axis of rotation:

Revolution Graphic Vertices
Vertex Index | Description
0 | Flags: PenUp, Editable, Linkable, Snappable, Selectable X, Y, Z: First point on axis of revolution Bulge: False
1 | Flags: PenUp, Editable, Linkable, Snappable, Selectable X, Y, Z: Second point on axis of revolution Bulge: False

A revolution graphic has three direct child graphics, a DATA graphic that holds the loft properties, a child non-cosmetic GRAPHIC or CIRCLE that define the polygon or circle that is being revolved, and a TCW60ACISSOLID cosmetic graphic. The non-cosmetic graphic is a CIRCLE in the case of a torus, and can be any polyline, arc, or polygon in the more general case. The coordinates of the revolved graphic are specified in the same world coordinate system as the axis of revolution.

Revolution ACIS Solid Cosmetic Child Graphic
Part | Description
Type | TCW60ACISSOLID
RegenType | (not available)
Normal Flags | Cosmetic, Editable, Visible
Subtype Extended Properties | (none)

The ACIS Solid has no vertices itself, but has two children (grandchildren of the original loft graphic): a DATA graphic that holds ACIS information and a SURFACE cosmetic graphic:

Revolution ACIS Solid Surface Cosmetic Child Graphic
Part | Description
Type | SURFACE
RegenType | (not available)
Normal Flags | Builtin, Cosmetic, Editable, Visible
Subtype Extended Properties | (none)

The surface has vertices that describe the faces of the revolution's tessellation. The number of these vertices varies depending on the geometry of the revolution graphic.

Revolution ACIS Solid Surface Cosmetic Child Vertices
Vertex Index | Description
0 to N-1 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Vertex of sphere face. Coordinates are defined relative to the center of the sphere. Bulge: False


Using 3D Loft Graphics (Regen)

Loft graphics are 3D interpolations between two or more 2D graphics. Lofts are created when you use the Cone, Prism or Loft tools in TurboCAD. The parent loft graphic has no vertices itself. Its geometry is completely defined by the non-cosmetic child graphics that the loft operation interpolates.

Loft Graphic Details
Part | Description
Type | TCW40LOFT
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

A loft graphic has four direct child graphics, a DATA graphic that holds the loft properties, two child non-cosmetic graphics that define the circles or polgyons that are the edges of the loft operation, and a TCW60ACISSOLID cosmetic graphic. For the Cone, one of the non-cosmetic graphics is a CIRCLE, and the other is a GRAPHIC with just one vertex. In the more general case, the two non-csometic graphics are just general polygons.

Loft ACIS Solid Cosmetic Child Graphic
Part | Description
Type | TCW60ACISSOLID
RegenType | (not available)
Normal Flags | Cosmetic, Editable, Visible
Subtype Extended Properties | (none)

The ACIS Solid has no vertices itself, but has two children (grandchildren of the original loft graphic): a DATA graphic that holds ACIS information and a SURFACE cosmetic graphic:

Loft ACIS Solid Surface Cosmetic Child Graphic
Part | Description
Type | SURFACE
RegenType | (not available)
Normal Flags | Builtin, Cosmetic, Editable, Visible
Subtype Extended Properties | (none)

The surface has vertices that describe the faces of the loft's tessellation. The number of these vertices varies depending on the geometry of the loft:

Loft ACIS Solid Surface Cosmetic Child Vertices
Vertex Index | Description
0 to N-1 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Vertex of sphere face. Coordinates are defined relative to the center of the sphere. Bulge: False


Using 3D Mesh Graphics (Regen)

The 3D Mesh Graphic is defined by a rectangular grid of vertices.

3D Mesh Graphic Details
Part | Description
Type | 3DMESH
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

The 3D mesh vertices are specified in row major order. So for a mesh with m rows and n columns, the vertices are listed as N(1, 1), N(1, 2), N(1, n), N(2, 1), … N(m, n).

3D Mesh Graphic Vertices
Vertex Index | Description
0 to N-1 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Point on mesh Bulge: False

There is only one child of the 3DMESH parent, a DATA graphic that contains the mesh properties.


Using Region Graphics (Regen)

Region graphics are created when you use the 2D Boolean tools to combine 2 2D graphics. The Region parent graphic has no vertices, since it is fully composed of the two non-cosmetic child graphics and an operation type.

Region Graphic Details
Part | Description
Type | TCW70Region
RegenType | (not available)
Normal Flags | Editable, Visible
Subtype Extended Properties | (none)

The parent Region graphic always has exactly 4 children: a DATA graphic containing the properties (including the operation type), and the two child non-cosmetic graphics that were used as parameters to the operation, and a cosmetic polygon GRAPHIC that is the visible result of the operation. Note that 2D Boolean operations can be nested (you can make a Region by combining already existing Regions), and that these nested cosmetic child graphics are retained in the hierarchy.


Using Camera Graphics (Regen)

The Camera Graphic is defined by two vertices that specify the position and orientation. You add a Camera graphic by using the Insert Camera menu command.

Camera Graphic Details
Part | Description
Type | TCCamera
RegenType | (not available)
Normal Flags | Editable, Visible, Unbounded
Subtype Extended Properties | (none)

These don't appear to do anything!

Camera Graphic Vertices
Vertex Index | Description
0 | Flags: PenDown, Editable, Linkable X, Y, Z: Location of camera Bulge: False
1 | Flags: PenDown, Editable, Linkable X, Y, Z: Point on axis of camera direction Bulge: False

Each Camera graphic has two children: a DATA graphic that holds property information, and a SURFACE cosmetic child graphic.


Using Light Graphics (Regen)

The Light Graphic is defined by two vertices that specify the position and orientation. You can add a Light graphic when you use the Ambient Light, Point Light, Directional Light, Headlight Light, or Spot Light tools.

Light Graphic Details
Part | Description
Type | TCLight
RegenType | (not available)
Normal Flags | Editable, Visible, Unbounded
Subtype Extended Properties | (none)

These don't appear to do anything!

Light Graphic Vertices
Vertex Index | Description
0 | Flags: PenDown, Editable, Linkable X, Y, Z: Location of light Bulge: False
1 | Flags: PenDown, Editable, Linkable X, Y, Z: Point on axis of light direction Bulge: False

Each Light graphic has five children: 2 DATA graphics that hold property information, 2 SURFACE cosmetic child graphics that are used to render the light in three dimensions, and a GRAPHIC cosmetic child for drawing parts of the light when it's selected.


Using Block Insertion Graphics (Basic)

An Insert graphic is used to place an instance of geometry defined by a Block. The insert contains a reference point and a matrix that defines where the Block's geometry will be located.

In TurboCAD the insert's matrix is specified by the location of 4 vertices. The insertion transformation matrix can be calculated directly from the coordinates of the 4 vertices and vice versa.

Insert formulas here.

Block Insertion Graphic Details
Part | Description
Type | INSERT
RegenType | (not available)
Normal Flags | BuiltIn, Editable, Visible
Subtype Extended Properties | (none)

An block insertion graphic is defined by exactly 4 vertices that are used to create a 4 x 3 transformation matrix that TurboCAD uses to calculate the position, orientation and scaling transformation that is applied to the block definition.

Block Insertion Graphic Vertices
Vertex Index | Description
0 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Insertion point of block reference, defines translation matrix row Bulge: False
1 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Defines matrix row (calculated as X, Y, Z difference from vertex 0) Bulge: False
2 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Defines matrix row (calculated as X, Y, Z difference from vertex 0) Bulge: False
3 | Flags: PenDown, Editable, Linkable, Snappable, Selectable X, Y, Z: Defines matrix row (calculated as X, Y, Z difference from vertex 0) Bulge: False

Show matrix math, derived from these vertices and the Block's Anchor vertex.


Exploding a Block Insertion

When you explode block insertion graphics with the Explode method, the Graphic objects that are contained by the reference Block object are copied to the Drawing's Graphics collection.

Is a group created?


Using Viewport Graphics

Viewports define polygonal regions (usually in PaperSpace) that refer to a Named View on the drawing's contents. Viewport Graphics are created when you use the Insert Viewport menu command. They are very similar to 2D polygons in their content:

Viewport Graphic Details
Part | Description
Type | VIEWPORT
RegenType | (not available)
Normal Flags | BuiltIn, Closed, Editable, Visible
Viewport Graphic Extended Properties
Property | Description
NamedView | String: name of NamedView in the drawing that provides zoom information to the viewport.

For a viewport polygon with N sides, TurboCAD actually builds N+1 vertices. Vertex 0 and vertex N must have the same coordinates. Most viewports are standard rectangles with 5 vertices:

Viewport Graphic Vertices
Vertex Index | Description
0 | Flags: PenDown, Editable X, Y, Z: Start point of line segment Bulge: False
1 to N-1 | Flags: PenDown, Linkable, Snappable, Selectable X, Y, Z: End point of line segment Bulge: False
N | Flags: PenDown, Linkable, Snappable, Selectable X, Y, Z: End point of line segment (must be the same as vertex 0) Bulge: False


Using The View Object

This section is AFTER Graphic type sections in the table of contents-see IMSIGX.XLS for latest order

We should go over every menu item and toolbar button in TurboCAD and figure out which object(s) you'd need to program similar functionality in the SDK. Then you could refer to those user interface items in the SDK docs, rather than have to explain all of TurboCAD. We could even have a "see also" link to the main TurboCAD help file.

You use the View object primarily to display portions of a TurboCAD drawing in a region of a window, to print a drawing, or to control the rendering of an object. By modifying a View's properties, you can control the position and zoom of the view, and whether the View is in paper space or model space. You can perform projection transformations to convert from 2D or 3D world coordinates to 2D screen coordinates and vice versa. You can also use the View object to find out what Graphic entities are located in the vicinity of a specified point or area in a TurboCAD drawing use the View object's PickResult collection. Typically the PickResult collection is used to analyze Graphic objects at the point of mouse click.

The View object represents an abstract concept of a particular projection of part of a 2D or 3D scene onto a 2D display surface. The View object itself does not create this display surface; instead it attaches to already created surfaces through the View properties HWND (to attach to a window handle) and DC (to attach to a Windows device context, which can be either a screen display device, printer, or graphics memory).

Note Since VBA does not allow to directly access hWnd and hDC properties of an object, to display a TurboCAD drawing in a VBA form you need to create an ActiveX control with necessary properties and place it on a form.


What's in a View?

The View object exposes as number of properties and methods that can be used to manipulate and/or customize the View object. The below list shows the most typically used properties and methods of the View object:

View Standard Properties
Property | Description
DC | Returns or sets the DC (device context) associated with this View object. Read-Write.
HWND | The HWND value of the View object's display Window. Read-Write.
ScreenLeft, ScreenTop, ScreenWidth, ScreenHeight | ScreenLeft: X coordinate of the left-hand side of the View object's screen space. Read-Write. ScreenTop: Y coordinate of the top of the View object's screen space. Read-Write. ScreenWidth: width the View object's screen space. Read-Write. ScreenHeight: height the View object's screen space. Read-Write.
ViewLeft, ViewTop, ViewWidth, ViewHeight | ViewLeft: X coordinate of the left-hand side of the View object's view space. Read-Write. ViewTop: Y coordinate of the top of the View object's view space. Read-Write. ViewWidth: width of the View object's view space. Read-Write. ViewHeight: height of the View object's view space. Read-Write.
CenterOnExtents | Converges the center of the View rectangle (set by ViewLeft, ViewTop, ViewWidth, ViewHeight properties) with the center of the screen rectangle (set by ScreenLeft, ScreenTop, ScreenWidth, ScreenHeight properties). Read-Write.
FixedAspectRatio | Returns or sets the View object's mapping to isotropic or anisotropic. Read-Write.
MappingMode | Returns or sets the mapping mode (screen measurement units, e.g. pixels) of the View object's associated device context. Read-Write.
Update | Specifies whether changes to parameters of the View object are immediately reflected. Read-Write.
SpaceMode | Returns or sets Drawing's space (Model Space or Paper Space) represented by the View. Read-Write.
RenderView | Returns the RenderView object that controls the View object. Read-Only.
ExternalView | Boolean: Returns a flag that tells whether an external 3D rendering process is controlling the View object.

View Methods
Method | Description
Delete | Deletes the View object.
Refresh | Causes repaint of a Drawing or any part of a Drawing associated with this View object according to the View's current settings.
ZoomToExtents | Sets the View object's extents (boundaries) to fit a drawing into extents of a window or DC (device context).
OpenBitmapDC | Opens and returns a DC (device context) to output View to a memory bitmap.
CloseBitmapDC | Closes the bitmap DC and returns the bitmap handle.
OpenMetafileDC | Opens a DC (device context) for Windows metafile drawing.
CloseMetafileDC | Closes the Windows metafile DC and returns a metafile handle.
GetMouseClick | Returns mouse point coordinates in the View's view space coordinate system.
PickPoint | Returns PickResult object that describes Graphic objects at specified point in the View's view space coordinate system.
ScreenToView | Converts screen space coordinates to the View's view space coordinates.
ViewToScreen | Converts the View's view space coordinates to screen space coordinates.
WorldToView | Converts world space coordinates to the View's view space coordinates.
ViewToWorld | Converts the View's view space coordinates to world space coordinates.


Using View Objects with VBA

When you open a new drawing project in TurboCAD a default View is automatically created, i.e. the Views collection of a TurboCAD drawing is not empty. You access a View object in your VBA project through the Views collection of a Drawing object:

Dim vw As IMSIGX.View
Set vw = ActiveDrawing.Views(0)

The currently active View (the one that has the input focus, in the foreground window) can also be accessed via the ActiveView property of the TurboCAD Drawing object:

Set vw As IMISGX.View
Set vw = ActiveDrawing.ActiveView

Having obtained a View object you can use the Refresh and ZoomToExtents methods to redraw the contents of the drawing within the view. When you are manipulating a built-in TurboCAD view you don't have to clear the TurboCAD window prior to calling redraw functions, the window will be cleared automatically.

You can also use the View Object's PickResult collection to determine which object was selected in a drawing.


Creating a View Without Specifying Context

In VBA, you can add a View to a Drawing if you need to perform object selection or create bitmaps or metafiles, and you don't want to use TurboCAD's predefined Views.

A new View is added to the Views collection by the Add method:

ActiveDrawing.Views.Add

If you use the Add method without parameters it will create an empty (uninitialized) View not associated with the drawing's window or a device context. It means you will have to manually set either hWnd or hDC properties for this View's to associate it with a window or with a device, as well set other required View properties.

You can also use OpenBitmapDC or OpenMetafileDC methods for such View to associate it with respective device context.


Creating a View Attached to a Window

If you want your new View to draw within the client area of an existing window, you supply the handle (hWnd property) of the existing window in the call to Views.Add:

Dim hWnd As Long
'Get hWnd value from somewhere
Dim vw As View
Set vw = ActiveDrawing.Views.Add(hWnd)

NOTE If you call the Views.Add method with both optional parameters (hWnd and hDC), the hDC parameter is ignored and only hWnd is used.

To specify hWnd parameter for the Add method you need an object that supports hWnd property. For instance, some Visual Basic object types that support hWnd are the UserForm, UserControl, and Frame objects.

In VBA you can obtain the hWnd by using calls to the Windows API. For instance, to get the hWnd of a UserForm, you can call the Windows API function FindWindow:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'Pass the text of the window caption to the FindWindow function
Dim hWnd As Long
hWnd = FindWindow(vbNullString, UserForm1.Caption)

If you use Add method with hWnd parameter, the View object you create will have its screen rectangle properties (ScreenWidth, ScreenHeight, ScreenLeft, and ScreenTop) set to the client area of the specified window. If you want to restrict the drawing area of the view to a smaller rectangle within the window, you can change these values to reflect the sub-rectangle, specified in client pixel coordinates. Normally, you only need to adjust the View's ViewLeft, ViewTop, ViewWidth, ViewHeight properties to reflect the part of the world you wish to display in the view. This can easily be done using ZoomToExtents method:

sample code to set up a new view

The Camera VBA sample gives an example of how to draw on a UserForm.


Creating a View Attached to a Device Context

If you want your new View to draw onto an existing Windows device context, you supply the handle (hDC property) of the device context in the call to Views.Add:

Dim hDC As Long
'Get hDC value from somewhere
Dim vw As View
Set vw = ActiveDrawing.Views.Add(, hDC)

NOTE If you call the Views.Add method with both optional parameters (hWnd and hDC), the hDC parameter is ignored and only hWnd is used.

To specify hDC parameter for the Add method you need an object that supports hDC property. In Visual Basic, the Printer object or the Image control's Picture object can supply an hDC.

After you create a View object using the hDC parameter you must set all of the screen and view rectangle properties for the new View object, in order to tell the View object where to draw within the device context. In addition, you must also set the View's MappingMode property to the correct Windows API setting. The MappingMode determines the coordinate system, scaling and vertical orientation for the device context. The normal setting to use for most device contexts is MM_TEXT (3).


Setting Up A Newly Created View

After you create a new view, you usually set several View object properties to control how the view will respond to zoom and camera changes. You usually set the FixedAspectRatio to True to ensure that X and Y scaling will be synchronized (so that the objects you draw won't appear stretched in one direction or the other). You also can set the CenteredOnExtents property to True to place the objects you draw at the center of the screen rectangle rather than at the top left corner.


Reassigning Views to Windows or Device Contexts

You can change HWND and DC properties of already existing Views. However, at each given time a View can set only one property of the two: either HWND or DC. In other words, you can't use HWND and DC properties simultaneously, e.g. you can't simultaneously output a View to a window and a memory bitmap.

You can associate several Views with one hWnd, yet it is not recommended to do the same with hDC. One hDC ought to be associated with one View object only.


Destroying a View

If you have previously created your own View object by adding a View to the Views collection with or without specifying a context for the View, you can destroy it using Delete method.

WARNING Do not delete any intrinsic View objects created by TurboCAD. Removing an intrinsic View will result in a TurboCAD application crash. Attempting to delete a non-existent View object causes a run-time error.

The Delete method releases memory allocated by TurboCAD to store the View structure. However, memory used by a VBA object encapsulating the View is not released. To completely destroy a View object you must make sure to destroy the object variable holding the View object:

vw.Delete
Set vw = Nothing

As a developer you are also responsible for destroying the window (hWnd) or device context (hDC) that the View was using, if necessary. Do not destroy these objects while a related View object still exists, it might cause undesirable results including system crash.


Accessing a Drawing's Views Collection

A View object is responsible for displaying a drawing in a window or for outputting a drawing to any output device. A drawing may have any number of views. To access and manipulate a drawing's views use Views collection. The following example prints the total number of all Views in the active drawing:

Debug.Print "Number of views in this drawing is " & ActiveDrawing.Views.Count


Accessing the Active View

The ActiveView is the window of a drawing that currently has the focus. To access the ActiveView object use the Drawing's object ActiveView property:

Dim vw as View
Set vw = ActiveDrawing.ActiveView

Should we have View.Active readonly property?


Redrawing a View

Any time you want to force a View object to redraw its contents, you can use the Refresh method:

vw.Refresh

Views are also redrawn any time their screen or view rectangles are changed. If you are manually setting any screen or view rectangle properties of your View object (such as ScreenTop, ScreenLeft, ViewTop, ViewWidth, etc.), you can suspend this drawing behavior by setting the View's Update property to False. After all the rectangle properties are changed, you can restore the default drawing mode by setting the Update property to True, and making an explicit redraw:

vw.Update = False
'Change some view rectangle properties here
vw.Update = True
vw.Refresh


Changing a View's Size: Zooming and Scrolling

The ZoomToExtents method is a convenient way to correctly set the view rectangle properties (ViewWidth, ViewHeight, ViewTop, ViewLeft) to display the entire contents of the drawing. Of course for complete control of the drawing, you can set these values yourself.

The Camera VBA sample gives some examples of how to change these properties to affect zooming and scrolling.


Changing the View Orientation

Every View object has an associated Camera object attached to it. You can control the camera's location and the location in world space that the camera is looking at through the Camera object's Location and LookAt properties. These must be coordinated with the View object's view rectangle coordinates.

The Camera VBA sample gives some examples of how the Camera properties can be changed these properties to affect the view orientation.


Using the Camera Object

The TurboCAD Camera object allows you to control the direction of viewing. You can control where the camera is located, where it is pointed, and if it is rotated around its viewing axis.


Fixing the Camera Location and Orientation

The TurboCAD Camera object is constructed to behave the same way that cameras are used in real life. The camera is mounted on a platform, analogous to the stable tripod that is used in physical cameras. The camera and platform share a common location specified in 3D world coordinates, accessible in the SDK as a Vertex object property named Location.

The camera lens points at a target location. The target is exposed as a Vertex object property named LookAt, and is also specified in 3D world coordinates.

TurboCAD defines four axes that are used to describe the possible orientation and motions of a camera. Each axis is exposed in the SDK as a Vertex object property. One axis (Up) is used to define the camera platform plane. Another axis (Right) is shared by the platform and the camera, and determines the rotation axis for up-down tilt operations on the camera. Two other perpendicular axes (Top and Direction) are attached to the camera only. Top specifies the direction vector coming out of the top of the camera, and Direction specifies the vector pointing from the camera and platform location towards the target. These four axes are always specified as vectors in the 3D world coordinate system. When you set any of these axes, at least one of the X, Y, or Z components must be non-zero. When you query for the axes, the Vertex object will return a normalized vector (the vector length will always be 1).

Since there are perpendicularity constraints and other interdependencies among the orientation properties, you will cause properties to be recalculated whenever you change them. This figure illustrates the points and vectors that describe the camera location and orientation:

insert figure here

The Location and LookAt properties are handled independently from one another. If you want to move the camera in a parallel manner, you must change Location and LookAt by the same relative X, Y, and Z values. The LookAt point and the Location points must never be set to the same values, or the SDK will force the camera Location point to be set a small distance back from the current LookAt point. Changing the Location or LookAt points may cause the Direction, Top and Right properties to change. The platform Up axis will remain unaffected.

insert sample code for changing Location and lookat

Changing the Up axis changes the orientation of the entire platform and camera system, causing a relative rotation of all other axes. The Right and Top properties will be recalculated based on the current Direction and the new Up properties. You will probably want to set at least one of these other properties after you have changed the Up axis in order to get the camera properly reoriented.

insert sample code for changing up and other values

Changing the Direction axis may cause the LookAt, Right and Top properties to be recalculated. The Up axis will remain unchanged.

insert sample code for changing direction

Changing the Right axis may cause the LookAt, Direction, and Top properties to be recalculated, since changing the Right axis is implemented as a Pan operation around the fixed Up axis (see below). In addition, the perpendicular relationship between the Up and Right axes means that the Right axis will be recalculated also.

insert sample code for changing right

The Top axis is readonly. You can use it to calculate new values for any of the other properties.


Changing the Camera Projection

Two other properties are needed to fully specify the camera's viewing characteristics. The Perspective property (a Boolean True or False) determines whether the camera is used in a perspective or orthographic projection. The orthographic projection is the equivalent of an optical camera with an infinite focal length (hyper-telephoto)-there are no vanishing points or foreshortening in the picture taken by this camera.

insert sample code for switching between ortho and perspective

TurboCAD's viewing model restricts you to an orthographic camera projection when you are using the native vector rendering system, but allows you to use the perspective camera projection (by setting the Perspective property to True) when you are using one of the advanced 3D rendering systems (OpenGL, Hidden Line, and Lightworks rendering). In this case, you can control the focal length of the camera by using the PerspectiveAngle property, which you specify as an angle in degrees between zero (infinite focal length telephoto) and 180 (fish-eye wideangle).

insert sample code for perspective

victor will modify SDK implementation (changes to Up and addition of Top)


Moving the Camera

Once the camera projection has been determined, you can use camera movement properties in the SDK to make the camera move. These settings for these properties attempt to model the movements used in physical camera setups.

Tilt represents the amount of rotation (applied to the Right camera/platform axis) that the lens of the camera swivels up or down at its current location. Since TurboCAD operates in a right-handed coordinate system, a positive Tilt value means the camera is pointing above the platform plane, a zero Tilt value means the camera is pointing along the platform plane, and a negative Tilt value means the camera is pointing below the platform plane. Tilt is measured in degrees, and should be restricted to the range -90 to +90.

Setting the Tilt property will cause the LookAt, Direction, and Top properties to change as a result of the swiveling of the camera at its current location. The Postion, Up and Right properties are left unchanged. The Tilt property value will be recalculated when you make explicit changes to the LookAt, Direction or Top properties.

insert sample code for tilting

Pan is method, not a property, that represents the amount of rotation around the platform Up axis (panning can be thought of as a left-right swiveling of the camera). This rotation is always made relative to the current camera orientation. In our right handed coordinate system, a positive Pan value represents a swivel of the lens to the left, a zero value represents pointing straight ahead, and a negative Pan value represents a swivel of the lens to the right. The Pan angle is also measured in degrees, normalized to the range -180 to 180.

Calling the Pan method with a non-zero value will force the the LookAt, Direction, Right and Top properties to be recalculated as a result of the swiveling of the camera at its current location. The Location and Up properties are left unchanged.

insert sample code for panning

The Roll property represents the amount that you spin the camera around its viewing axis (specified by the Direction property). In the right-handed coordinate system, a positive Roll angle spins the top of the camera to the right. A zero Roll angle means that the Up vector of the platform will be projected as a vertical axis on the projected film plane (this is the normal state of affairs for most photography). As an example, for a typical plan view the normal Up vector will be specified as the +Y axis (0, 1, 0). The platform (and the resulting projected image) can be inverted by setting the Up vector to the -Y axis (0, -1, 0). Setting Roll equal to zero in the will result in a standard plan view in the first case, and an inverted plan view in the second. The Roll angle is also measured in degrees, normalized to the range -180 to +180.

insert sample code for rolling

tangent following method would be cool: track a graphic; ease in/ease out…

Setting the Roll property causes the Top and Right properties to change. The Location, LookAt, Up and Direction properties are left unchanged. Conversely, changing the Up property may cause the Roll property to change, as the platform is moved while the camera's viewing axis stays the same.

Finally, the camera can be tracked by setting appropriate values for Location and LookAt.

insert sample code for tracking


Using the Named View Object

The camera position and zoom factor that represent a view can be stored in the Drawing object's NamedViews collection. A NamedView is an object that you can use to remember these settings and return to them later. You can add any number of NamedView objects and change the current active view to them using this collection.

You access a NamedView by using the standard collection methods. For example, this code changes the active view to the settings stored in a NamedView with the name "View_0":

Dim nvw As NamedView
Set nvw = ActiveDrawing.NamedViews("View_0")
ActiveDrawing.ActiveView.ZoomToNamedView(nvw)


Saving the Current View Using the NamedViews Collection

what about camera settings in named views?

Another way to control the location and orientation of views is via the Drawing object's NamedViews collection. You can save the current view rectangle and camera settings in a NamedView object, and add it to the drawing for future use:

With ActiveDrawing.ActiveView
   Set nvw = ActiveDrawing.NamedViews.Add("SaveMe", _
      .ViewLeft, .ViewTop, .ViewWidth, .ViewHeight, .Camera)
End With


Restoring the View from a NamedView Object

Once you have created a named view either with the TurboCAD UI, or with the SDK you can set any views' zoom level to it by using the View object's ZoomToNamedView method:

ActiveDrawing.ActiveView.ZoomToNamedView("SaveMe")

You can also query the named view for the size (in world coordinates) that the view represents, by using the NamedView object's BoundingBox property:

Dim bbox As BoundingBox
Set bbox = ActiveDrawing.NamedViews("SaveMe").BoundingBox
Debug.Print "Min x: " & bbox.Min.X
Debug.Print "Min y: " & bbox.Min.Y
Debug.Print "Max x: " & bbox.Max.X
Debug.Print "Max y: " & bbox.Max.Y


Using Named Views in Viewports

The viewport graphic is a rectangular window onto model space that you put on a paper space view, that lets you project the model space graphics in a view onto the paper space. In order to create a paper space viewport graphic, you need to have previously created a named view that the viewport will use to determine the zoom level. After creating the viewport graphic, you set the NamedView property of the graphic to the name of the appropriate view:

'Drawing must be in paper space mode
'Viewport graphic goes on paper space
'Add viewport graphic and set it up
Dim vpg As Graphic
Set vpg = ActiveDrawing.Graphics.Add(imsiViewport)
With vpg
   'Set the NamedView property
   .Properties("NamedView") = "SaveMe"
End With

In addition, you must take care to set up the viewport's location and scale correctly. The Viewport VBA sample shows how to create a viewport with the proper factors. For more on viewport graphics, see the "Basic and Regen Graphics in Detail" section.


Changing a View's SpaceMode

Each View object has an active SpaceMode, that determines whether it is drawing ModelSpace or PaperSpace graphics, and which coordinate system it is using. In PaperSpace mode, the View's Camera settings have no effect, but the location and zoom level can be modified.

When you create a new view, the SpaceMode property tracks the current SpaceMode of the view's parent drawing. This behavior is lost as soon as you set view's SpaceMode property. From that point on, you are responsible for maintaining the SpaceMode property explicitly. Getting the current view SpaceMode does not affect whether the tracking is done or whether the view's SpaceMode is controlled by the programmer.


Creating Bitmaps and Metafiles with the View Object

Sometimes instead of working with a TurboCAD drawing directly in the window you might want to output it to a bitmap or Windows metafile created in memory. For instance, this helps avoid flickering of flashing of a drawing in the window when a drawing is repainted. Besides, working with a drawing in memory is faster then in a window.

View object exposes four methods to create a bitmap or metafile in memory:

OpenBitmapDC

OpenMetafileDC

CloseBitmapDC

CloseMetafileDC

When you use the OpenBitmapDC or OpenMetafileDC methods, the View will be disconnected from the window or device context it was previously associated with. The view will stop painting into that window or DC. Instead it will paint into the bitmap or metafile in memory, preserving all settings the View object had at the moment when the OpenBitmapDC or OpenMetafileDC method was called. The original window or device context and other settings will be restored after the CloseBitmapDC or CloseMetafileDC methods return.

NOTE If the View object's MappingMode setting is set to a value other then pixels (MM_TEXT), you should convert it to pixels prior to executing the OpenBitmapDC or OpenMetafileDC method. It is desirable to adjust the View's screen properties (ScreenLeft, ScreenTop, ScreenWidth, ScreenHeight) to reasonable values in pixels before calling the OpenBitmapDC or OpenMetafileDC method.

The OpenBitmapDC and OpenMetafileDC methods do not draw into a memory bitmap or metafile immediately. Actual drawing occurs only when one of the methods causing view drawing is executed (Refresh, ZoomToExtent, etc.) or when the View's Update property is set to True.

After the execution of the OpenBitmapDC or OpenMetafileDC method you can change the View rectangle's parameters (ViewLeft, ViewTop, ViewWidth, ViewHeight), so that you can re-adjust the View to output another part of a drawing into a bitmap. It is recommended to set the View's Update property to False before changing the View's rectangle, otherwise each new property setting will cause painting over the same bitmap.

It is not recommended although possible to modify View's screen properties (ScreenLeft, ScreenTop, ScreenWidth, ScreenHeight) after the OpenBitmapDC or OpenMetafileDC methods have been executed. It will not change the created bitmap, yet potentially might cause unpredictable and undesirable results.

The usual way you will create an image is to make exactly one call that will cause a redraw between the execution of the OpenBitmapDC or OpenMetafileDC method and its corresponding CloseBitmapDC or CloseMetafileDC call. After the bitmap or metafile has been opened in memory each new redraw paints over the current bitmap or metafile, so if you want to make multiple redraws, you may need to use Windows API functions to manipulate the image bits.

simple example

The CloseBitmapDC and CloseMetafileDC methods release the internal device context created by the corresponding OpenBitmapDC or OpenMetafileDC method and then return an image handle to the caller. CloseBitmapDC returns a device-independent bitmap in an array of Bytes. CloseMetafileDC returns a windows enhanced metafile stored in an array of Bytes.

note change to interface and implementation for these

After calling CloseBitmapDC or CloseMetafileDC, you can use the resulting handle in a Windows Graphics Device Interface ("GDI") function such as GetDIBits or PlayMetaFile. When you don't need the memory bitmap or metafile any more, don't forget to remove it from memory. The bitmap handle should be destroyed using the GlobalFree Windows API function, and the metafile using DeleteMetaFile.

You can work with bitmaps and metafiles in VBA using Windows API functions, but there is no easy facility provided for using them directly. Instead VBA objects such as the Image control and UserForm always use a StdPicture object to display bitmap and metafile-based images. Using the StdPicture object frees you from dealing with the complexities of Windows GDI objects.

The TurboCAD SDK includes a helper DLL named ViewPict that converts the bitmaps and metafiles generated by the TurboCAD SDK into StdPicture objects. C++ source code and the DLL that you can use with VBA are included in the SDK installation. Because the functions in ViewPict create a StdPicture object that owns the original bitmap or metafile image, you don't have to explicitly destroy the bitmap or metafile that the TurboCAD View object created when you use these functions.


Using Views To Transform Coordinates

The View object contains utility functions that allow you to convert from view coordinates to world coordinates or from view coordinates to screen coordinates and vice versa:

ScreenToView

ViewToScreen

WorldToView

ViewToWorld

some example?


Picking in Views

View objects can be programmed to let a user interactively select graphics shown in a view. You can use the GetMouseClick view method to wait for a user to click in a view. When this function returns, the X and Y parameters will contain the location of the click in view coordinates:

Dim xClick, yClick As Double
ActiveDrawing.ActiveView.GetMouseClick xClick, yClick

You can use these view coordinates to find out where the user clicked on the screen, or translate them to world coordinates by using the view's coordinate conversion utility functions. You can also ask the view to return a collection of graphics that intersect the click coordinates.

The PickPoint view method takes the view coordinates (as returned by GetMouseClick) and returns a PickResult object (a standard VBA collection) containing all the graphics under the point. You can also submit two points that define the opposite corners of a rectangle in view coordinates to the PickRect method, and it will return a PickResult of all the graphics contained within the view rectangle.

Dim pres As PickResult
Set pres = ActiveDrawing.ActiveView.PickPoint(xClick, yClick)

There is also a drawing method called PickInteractive which waits until the user clicks in any view of the drawing, and returns the PickResult with the results of the click:

Dim pres As PickResult
Set pres = ActiveDrawing.PickInteractive(imsiPickPoint)


Using the PickResult Collection and PickEntry Objects

Each item in the PickResult collection is a PickEntry object that gives information about the graphic picked, what part of the graphic was hit, and how far from the point (or rectangle) the graphic is. You can enumerate the collection and collect or process the picked graphics. Here's an example that selects only the circle objects that have been placed in the PickResult by the previous pick operation:

Dim pent As PickEntry
For Each pent In pres   With pent.Graphic      If .Type = "CIRCLE" Then         .Select      Else         .Unselect     End If  End WithNext


Working With Model Space and Paper Space Layouts

Usually you want to create the graphical contents of your drawing in model space, a 3D "world" coordinate system that can contain 2D and 3D objects. The coordinates you use to create graphics are measured in real world units. When you want to print your drawing, you normally work in one or more Layouts. The contents of each layout are contained in a separate paper space, for which there is only a "plan view" looking down on the virtual paper. Each paper space can have its own independent unit system and scale factor. The paper space can contain viewport graphics that represent different views (camera and scaling) of the contents of the single model space world, as well as "decorative" or per-layout graphics such as dimensions, text, diagrams and tables.

You always work with one active space in a drawing at a time, and the SDK provides mechanisms for switching from one active space to another.


Detecting the Current Space

The Drawing object's TileMode property allows to get or set a drawing's current space, i.e. Paper Space or Model Space. The default value for TileMode is 1 (Model Space). TileMode is an Integer property that can take on the values in the ImsiSpaceMode enumeration:

imsiPaperSpace (0): Paper Space

imsiModelSpace (1): Model Space

Here's an example of how to test the current mode:

'Get the current drawing space mode
Select Case ActiveDrawing.Properties("TileMode")
   Case imsiPaperSpace:
      Debug.Print "Current space mode is Paper Space"
   Case Else:
      Debug.Print "Current space mode is Model Space"
End Select


Changing Between Model Space and Paper Space

To change the the drawing's current space (Paper Space or Model Space), you set the Drawing object's TileMode property to an Integer specifying the desired mode. You use the value imsiModelSpace (1) to set Model Space, and imsiPaperSpace (0) to set Paper Space:

'Set drawing mode to Paper Space
ActiveDrawing.Properties("TileMode") = imsiPaperSpace


Adding a New Paper Layout

The Drawing object's PaperSpaces collection manages the layouts for a drawing. You can create a new layout by using the collection's Add method:

Dim ps As PaperSpace
Set ps = ActiveDrawing.PaperSpaces.Add("NewLayout")


Removing a Paper Layout

You can also remove a layout:

ps.Delete
Set ps = Nothing

Can you remove the "default" paper layout? How can you tell what this one is?


Changing the Active Paper Layout

Once you have set the drawing space mode to paper space, one of the paper layouts will be active. To determine which one, use the ActivePaperSpace property of the Drawing object:

'Get current active space
Dim ps As PaperSpace
Set ps = Drawing.ActivePaperSpace
Debug.Print "Active paper space is " & ps.Name

If you have a paper space object, you can also test whether it is active or not:

'See if it really is active
If ps.Active Then
  Debug.Print "Paper space " & ps.Name & " is active"
Else
  Debug.Print "Paper space " & ps.Name & " is inactive"
End If

To make another paper space active, use the Activate method:

ps.Activate

Add PaperSpace.Active property to IDL


Setting Paper Space Parameters

Once a paper space is active, you can set up scale and unit information by using extended properties in the Drawing object. Changing these properties only affects the current active paper space. Other paper spaces in inactive layouts will not be changed.

PaperLinearUnits

Need to alias $PLUNITS to PaperLinearUnits

Analogy to model space property

The Drawing object's PaperLinearUnits property determines a family of unit and scale systems that you can use when working with Paper Space. PaperLinearUnits is an Integer property that can take these values:

1: English System

2: Metric System

If you're using the SDK to set up your paper space, you must take care that other parameters you set are compatible with the PaperLinearUnits property currently being used. These compatibility issues will be mentioned as the other properties are described.

'Set paper space units family to English
ActiveDrawing.Properties("PaperLinearUnits") = 1 'English

PaperScaleSystem

Analogy to model space property

The Drawing object's PaperScaleSystem property determines the range of paper to world scales available to the user. TurboCAD lets you set the drawing scale using one of three standard systems: Architectural, Engineering, and Absolute. If the drawing's measurement family (as determined by the PaperLinearUnits property) has been set to Metric, then Absolute will be the only choice available. The following table shows some sample drawing scales expressed in each of these systems:

Architectural:3/16" = 1'-0"

Engineering: 1"= 200'

Absolute: 1:500

You can set PaperScaleSystem through TurboCAD menu: Options à Space Units.

The PaperScaleSystem property is a String with the name of the current scaling system for Paper Space, i.e. ratio of measurements on the page (Paper units) to measurements in the object being modeled (World units). The default value for PaperScaleSystem is "Architectural", with a PaperScale of 1" = 1", one inch to one inch.

To change the PaperScaleSystem property setting, assign it a String containing the name of the scaling system. Valid settings are: "Absolute", "Engineering", "Architectural":

'Set scaling system to architectural
ActiveDrawing.Properties("PaperScaleSystem") = "Architectural"

Note that it is also possible to assign any string value to the PaperScaleSystem property, yet . . .

Is $SCALESYS the same (an alias for) PaperScaleSystem?

PaperScale

Analogy to model space property

The Drawing object's PaperScale property allows you to get and set the scale that converts world units to paper units. You specify this scale as a String. Depending on the scale system selected, the string can be of different forms, i.e "1:2", "1 in=200 ft", etc.) The default PaperScale property setting is "1:1".

To change the PaperScale property setting assign it a string containing the specified scale, e.g.:

'Set scaling to half of the actual size
ActiveDrawing.Properties("PaperScale") = "1:2"

PaperLinearUnitName

Analogy to model space property

The Drawing object's PaperLinearUnitName property allows you to get or set the name of currently used measurement unit for graphics in Paper Space ("in", "m", "mm", etc.):

'Set paper space measurement unit name to inches
ActiveDrawing.Properties("PaperLinearUnitName") = "in"

The PaperLinearUnitName setting must correspond to the PaperLinearUnits setting, i.e. if you set PaperLinearUnits to 1 (English) you should use English measurement system. Theoretically it is possible to specify measurement unit name conflicting with the measurement unit system, yet it might cause unpredictable results.

PaperLinearUnitName2

Analogy to model space property

The Drawing object's PaperLinearUnitName2 controls the name of currently used measurement units for text in Paper Space. This is a String propertywhich gives the unit name ("in", "m", "mm", "pt", etc.). The default setting for PaperLinearUnitName2 is "pt" (points). To change the PaperLinearUnitName2 setting assign a String variable containing the name of the specified measurement units, e.g. "in" (inches):

'Set text measurement unit name to inches
ActiveDrawing.Properties("PaperLinearUnitName2") = "in"

PaperLinearUnitName3

Analogy to model space property

Similar to the other unit names in Paper Space, the Drawing object's PaperLinearUnitName3 lets you get or set the name of the currently used measurement units for line width in Paper Space. This is also a String property that gives a unit name ("in", "m", "mm", "pt", etc.). The default setting for this property is "pt" (points). To change the PaperLinearUnitName3 setting assign a string variable containing the name of the specified measurement units, e.g. "in" (inches):

'Set line width measurement unit name to inches
ActiveDrawing.Properties("PaperLinearUnitName3") = "in"


Using Graphics in Model Space and Paper Space

Every graphic is contained only one space: either the model space, or one of the drawing's layout paper space. Any operations on individual graphics and their owning collections (adding, selecting, etc.) always apply to the currently active space.

How can you tell if a graphic is in model space or in which paper space?


Using Views in Model Space and Paper Space

Views are associated with a particular space: either the single model space, or one of the layout paper spaces. Views behave differently in paper space than in model space. The View's camera is inactive in paper space; making changes to the camera will have no effect. The only control you have over a paper space view is modifying the view's screen and view coordinates.

How can you tell if a view is in model space or in which paper space?


Controlling Page Setup Using the Drawing Object

By setting the following extended Drawing properties, you can change the page setup for the active PaperSpace. Many of these properties are exposed on the Page Setup dialog in the TurboCAD user interface.

Drawing Page Setup Extended Properties
Property | Description
PaperWidth | Width of paper in printer, measured in units of 0.1mm, i.e. 2794 is 279.4 mm or 11 inches.
PaperHeight | Height of paper in printer, measured in units of 0.1mm, i.e. 2159 is 215.9 mm or 8.5 inches.
PaperScale | Scale for paper space as string, i.e. "6" = 1'-0" (Half Size)".
$PLUFACTORS | Array: X, Y, and Z scale factors for the active paper space. So if PaperScale is "half size" as above, this is (0.5, 0.5, 0.5).
PaperLinearUnits | String for paper space units, i.e. "in" for inches. This is not what the documentation above indicates…
PaperLimitsMin | Array: X, Y, and Z coordinates for bottom right (origin) of sheet, measured in paper space units. For example (-5, -4, 0) corresponds to Origin X: -5" and Origin Y: -4" on the Page Setup dialog's Layout tab, if the current paper space unit is inches.
PaperLimitsMax | Array: X, Y, and Z coordinates for top right of sheet, measured in paper space units. By subtracting PaperLimitsMin from this you can get the sheet size. For example, if PaperLimitsMax is (17, 13, 0), and PaperLimitsMin is (-5, -4, 0), then the sheet size is (22, 17, 0). This difference corresponds to World Width: 22" and World Height: 17" on the Page Setup dialog's Layout tab.
$PVPXMIN | Paper space viewport extents minimum X value, measured in paper space units.
$PVPXMAX | Paper space viewport extents maximum X value, measured in paper space units.
$PVPYMIN | Paper space viewport extents minimum Y value, measured in paper space units.
$PVPYMAX | Paper space viewport extents maximum Y value, measured in paper space units.

$PLUORIGIN (<NO ALIAS>) -- Not listed if I enumerate Drawing Properties in tile mode 0.
$PEXTMIN (PaperExtentsMin) -- Always appears to be (0, 0, 0).
$PEXTMIN (PaperExtentsMin) -- Always appears to be (0, 0, 0).
$PGMARGL (MarginLeft) -- Always appears to be 0. Should correspond to "Margins Left:" on Page Setup dialog's Layout tab?
$PGMARGT (MarginTop) -- Always appears to be 0. Should correspond to "Margins Top:" on Page Setup dialog's Layout tab?
$PGMARGR (MarginRight) -- Always appears to be 0. Should correspond to "Margins Right:" on Page Setup dialog's Layout tab?
$PGMARGB (MarginBottom) -- Always appears to be 0. Should correspond to "Margins Bottom:" on Page Setup dialog's Layout tab?
$LAYOUTCOLUMNS (PrintColumns) -- Always appears to be 1. Should correspond to "Columns:" on Page Setup dialog's Layout tab?
$LAYOUTROWS (PrintRows) - Always appears to be 1. Should correspond to "Rows:" on Page Setup dialog's Layout tab?
$VPXMIN (ViewMinX) -- Not listed if I enumerate Drawing Properties in tile mode 0.
$VPXMAX (ViewMaxX) -- Not listed if I enumerate Drawing Properties in tile mode 0.
$VPYMIN (ViewMinY) -- Not listed if I enumerate Drawing Properties in tile mode 0.
$VPYMAX (ViewMaxY) -- Not listed if I enumerate Drawing Properties in tile mode 0.
$LUNITS (LinearUnits) -- String for world units, i.e. "in" for inches.
$LUINMM (LinearUnitsPerMm--bad! this should be LinearUnitsInMm) -- Double representing world units in mm, i.e. 25.4 for inches.
$LUFACTORS (LinearUnitScales) -- Always appears to be (1, 1, 1). Is this the ModelSpace equivalent to $PLUFACTORS?
$LUORIGIN (LinearUnitOrigin) -- Always appears to be (0, 0, 0). Is this the ModelSpace equivalent to $PLUORIGIN?
$EXTMIN (ExtentsMin) -- Always appears to be (0, 0, 0). Is this the ModelSpace equivalent to $PEXTMIN?
$EXTMAX (ExtentsMax) -- Always appears to be (0, 0, 0). Is this the ModelSpace equivalent to $PEXTMAX?
$LIMMIN (LimitsMin) -- Always appears to be (0, 0, 0). Is this the ModelSpace equivalent to $PLIMMIN?
$LIMMAX (LimitsMax) -- Always appears to be (0, 0, 0). Is this the ModelSpace equivalent to $PLIMMAX?

Need sample code


Controlling 3D Rendering

TurboCAD has extensive support for high-quality rendering of 3D objects. The Render and RenderView objects in the object model hierarchy allow you to set up a rendering system, start a rendering job, and save the result as a bitmap.


Using the Renders Collection

You can find out the available rendering capabilities and set up preferences for 3D rendering by using the Render objects contained in the Application object's Renders collection. You can enumerate all the possible rendering modes by trying out the following example:

    Dim i, j, rcount As Long
    Dim rnd As Render
    Dim rmodes As Variant
    With Application.Renders
        rcount = .count
        For i = 0 To rcount - 1
            Set rnd = .Item(i)
            Debug.Print "Render: " & rnd.Name
            rmodes = rnd.modes
            If VarType(rmodes) <> vbEmpty Then
                For j = 0 To UBound(rmodes)
                    Debug.Print " Mode: " & rmodes(j)
                Next
            Else
                Debug.Print " No modes"
            End If
            rmodes = rnd.RadExtendedModes
            If VarType(rmodes) <> vbEmpty Then
                For j = 0 To UBound(rmodes)
                    Debug.Print " Radiosity mode: " & rmodes(j)
                Next
            Else
                Debug.Print " No radiosity modes"
            End If
        Next
    End With


Using the Render Object

Each Render object represents a particular 3D rendering system. TurboCAD ships with the industry standard OpenGL rendering system, a native hidden line renderer, and a high-quality raytracing and radiosity system licensed from Lightwork Design, Ltd. The properties of the Render object allow you to query the capabilities of the particular rendering system, and to set up the defaults for new rendering jobs.

Render Properties
Property | Description
Name | (Readonly) String: The name of the process, such as "OpenGL".
RenderModesCount | (Readonly) The number of primary render modes that this process supports.
Modes | (Readonly) Array of ImsiRenderMode: The collection of IDs of the render modes supported by this process.
DefaultMode | ImsiRenderMode: The default render mode ID for new renderings.
RadExtendedRenderModesCount | (Readonly) The number of radiosity render modes that this process supports.
RadExtendedRenderModes | (Readonly) Array of ImsiRenderMode: The collection of IDs of the radiosity render modes supported by this process.
RadExtendedMode | ImsiRenderMode: The default secondary rendering mode if primary mode is set to Radiosity.
RadQuality, RadIterationsCount, RadMinArea, RadMaxArea | Quality settings for radiosity rendering.
Render Methods
Method | Description
RunPicture | Perform a rendering process. Does not return until the process is finished. Returns a StdPicture containing the image of the rendering.

Once you have set the rendering mode and quality you can get a bitmap rendering from any view by calling the Render object's only method, Run:

    Dim vw As View
    Dim rnd As Render
    Dim opic As IPicture

    'Set up the camera
    Set vw = ActiveDrawing.ActiveView
    vw.Camera.Perspective = True

    'Set up the rendering type
    Set rnd = Application.Renders("OpenGL")
    rnd.DefaultMode = imsiRenderModeGouraud

    'Run the rendering process
    Set opic = rnd.RunPicture(vw)
    If Not opic Is Nothing Then
        SavePicture opic, "D:\Test.bmp"
    End If

Currently, Run is returning Nothing - need to fix

If you are planning to run a rendering using a time-consuming process, such as radiosity, you can start, monitor and cancel the progress by using the RenderView object.


Using the RenderView Object

For finer control over the rendering process, you can use the RenderView object. Every View object has an associated RenderView object that gives you control over the 3D rendering process. To control the 3D rendering characteristics, you set the properties of the RenderView object.

RenderView Properties
Property | Description
RenderID | Integer: A user-definable ID. If the RenderView has previously been initialized, setting the RenderID property starts another rendering job.
RenderMode | ImsiRenderMode: Primary rendering mode.
RadExtendedMode | ImsiRenderMode: Secondary rendering mode if primary mode is set to Radiosity.
RadQuality, RadIterationsCount, RadMinArea, RadMaxArea | Quality settings for radiosity rendering.
Picture | (Readonly) Retrieves a StdPicture object containing the bitmap of the current rendering.
IsRenderRunned | (Readonly) Boolean: True if a rendering has begun and has not yet terminated

When the RenderView is correctly set up, you can start or stop a rendering pass by using RenderView object's methods.

RenderView Methods
Method | Description
BeginRender | Starts a new, or restarts the existing rendering job for the RenderView.
DoRender | Starts another rendering job for the RenderView. Returns an error if the RenderView has not been initialized by a previous call to BeginRender, or is currently in the middle of a rendering process.
EndRender | Terminates the current rendering process.

Starting a 3D rendering job by using the Render object's Run method, or by using the RenderView's BeginRender or DoRender methods, causes the RenderView object to take control over its owning view's processes. You can check whether a View's rendering is currently being taken over by the 3D rendering engine by examining the View's ExternalView Boolean property.


Setting Parameters for 3D Rendering


Starting a Rendering Job


Capturing a Rendering Image


Canceling a Rendering Job

Need examples


Finding out About the Application and Drawing Environments

A few miscellaneous collections provided by the SDK let you find out about the runtime extensions to TurboCAD.

Note that the code below doesn't work as of 3/26/01: For Each (_NewEnum/Next) runs infinitely, and omits one entry


Using the RegenMethods Collection

A RegenMethod is a process packaged in a DLL located in TurboCAD's Regens directory that is responsible for maintaining the properties of a graphic object subtype. You can write RegenMethod DLLs using the SDK with an external development system (see the Advanced Projects section for more information on writing your own RegenMethod DLL).

The Application object's RegenMethods collection returns all currently registered external objects, both built-in (shipped with TurboCAD program) and user-designed objects.

The following example prints all RegenMethods to the Immediate Window:

Dim rm As RegenMethod
For Each rm In Application.RegenMethods
    Debug.Print rm.Name
Next


Using the Filters Collection

A Filter (or file converter) is a process packaged in a DLL located in TurboCAD's Filters directory that is responsible for opening and saving of files of a certain type (format). You can write Filter DLLs using the SDK with an external development system (see the Advanced Projects section for more information on writing your own Filter DLL).

By enumerating the Application's Filters collection you can get a list of the file types supported by TurboCAD in your application environment.

The following example prints file extensions recognized by TurboCAD and their descriptions to the Immediate Window.

Dim flt As Filter
For Each flt In Application.Filters
      Debug.Print flt.Extension; ", " flt.Description
Next

Can you open a file with this collection? Not implemented…


Using the Tools Collection

A Tool is a process contained in a DLL in TurboCAD's Tools directory that can be integrated into the TurboCAD user interface. You can write Tool DLLs using the SDK with an external development system (see the Advanced Projects section for more information on writing your own Tool DLL). You can find out the names of all the currently registered Tools by enumerating the Application object's Tools collection:

Dim t As Tool
For Each t In Application.Tools
   Debug.Print t.CommandName
Next

You can also run any of these tools from the SDK by using the Tool object's Activate method:

Application.Tools("someName").Activate


Using the Macros Collection

A Macro object in TurboCAD is an object that holds information about a Visual Basic for Applications project associated with a drawing (packaged in a .TCM file). You can list all the VBA projects associated with a drawing by enumerating the Drawing object's Macros collection:

Dim mac As Macro
For Each mac In ActiveDrawing.Macros
   Debug.Print "Macro " & mac.Name & ", contained in " & mac.Path
Next

Can't list modules, userforms, or class modules within a "Macro"

Can't list subs within a module

Can't run subs from SDK


Using Events


Events and Event Handlers

Most code that you write directly controls what TurboCAD does, and you as the programmer specify the time when the code is executed. At times, however you may want to write code that is triggered by an action that a user has performed in TurboCAD. These triggers are called events. Using the SDK, you can establish a connection between TurboCAD's event mechanism and subroutines that you write, called event handlers, that will be called by TurboCAD as the event is triggered (or "fired"). In this way you can trap mouse movements, drawings being opened or closed, and other actions.


TurboCAD Event Interface

The suite of events that TurboCAD fires is defined by an event interface. Each event has an exact signature (sub name, and number, type, and order of parameters) that you must implement as a subroutine that you declare in Visual Basic for Applications class module or user form. Since the event mechanism is constructed as a late-bound interface, you don't have to implement all the events that TurboCAD may fire, just the ones you need to handle, and you can tell TurboCAD explicitly which events you're interested in.

The following table lists the complete event interface. For the detailed syntax of each event, consult the Visual Basic Reference.

TurboCAD Events
Event | Description
BeforeExit | Fired before the Application object quits.
DrawingNew | Fired after a new Drawing object is created.
DrawingOpen | Fired after an existing Drawing object was opened.
DrawingActivate | Fired after a Drawing object was activated.
DrawingDeactivate | Fired when a Drawing object will be deactivated.
DrawingBeforeClose | Fired before a Drawing object is closed.
DrawingBeforeSave | Fired before a Drawing object is saved.
DrawingAfterSave | Fired after a Drawing object was saved.
MouseDown | Fired when a mouse button was pressed.
MouseUp | Fired when a mouse button was released.
MouseMove | Fired when the mouse was moved.
BeforeDoubleClick | Fired before a double click action is taken.
BeforeRightClick | Fired before a right click action is taken.
SelectionChange | Fired after the Selection object has changed.
RunTool | Fired when a Tool object is activated.
PointSnapped | Fired when a point was picked in a View object.
PointPick | Fired when a point pick operation was completed or canceled.
RectanglePick | Fired when a rectangle pick operation was completed or canceled.
PolygonPick | Fired when a polygon pick operation was completed or canceled.
VirtualIntersectionPick | Fired when a virtual intersection pick operation was completed or canceled.
Drop | Fired after something was dropped into a drawing.
ViewBeforeRedraw | Fired before a View object is redrawn.
ViewAfterRedraw | Fired after a View object was redrawn.
WindowResize | Fired when a Window object was resized.
WindowActivate | Fired when a Window object was activated.
WindowDeactivate | Fired before a Window object is deactivated.
CommandBarControlHit | Fired when a CommandBarControl object was hit.
CommandBarControlStatus | Fired to inquire on the status of a CommandBarControl object.
CommandBarControlDone | Fired after the command has finished.


Handling TurboCAD Events in VBA

To set up event handling you need to do three things in your Visual Basic for Applications project:

  • Create a class module (or user form) with subroutine named and defined with signatures from the list of available events.
  • Instantiate an event handler class object from your class module or user form with the New statement.
  • Call the TurboCAD Application object's ConnectEvents method, passing the event handler class object, and a mask value that tells TurboCAD which events you are handling.

The ConnectEvents method returns a connection ID as a Long. The mask parameter is required to listen only to a subset of the full event set.

The following example shows how create a class module to listen to MouseDown event and a module to process this event.

First create the event handler class module. In the Visual Basic Editor, right click on the current project and choose "Insert… Class Module" from the context menu. Change the name of the class module from "ClassModule1" to "clsEvents" in the object browser. Then create a public subroutine named MouseDown:

Public Sub MouseDown(WhichDrawing As Drawing, WhichView As View, _
  WhichWindow As Window, Button As ImsiMouseButton, _
  Shift As Long, X As Long, Y As Long, Cancel As IMSI_BOOL)
     MsgBox "MouseDown Event: X = " & X & ", Y = " & Y
End Sub

Now insert the regular module you'll use to connect the event handler, and create a subroutine you can call as a TurboCAD macro:

'Global variable to store connection number
Public idConnection as Long

'Connection subroutine
Public Sub EstablishMouseDownHandlerConnection()
    'Create the event handler object
    Dim handler As New clsEvents
    'Disconnect any previously connected events
    If idConnection > 0 Then
        Application.DisconnectEvents idConnection
    End If
    'Connect the handler
    'Use imsiEventMouseDown mask (only send us MouseDown events)
    idConnection = Application.ConnectEvents(handler, imsiEventMouseDown)
    'We don't need the reference to our handler anymore
    'But TurboCAD now has a reference to it!
    Set handler = Nothing
End Sub

The class module for handling events must implement at least one valid TurboCAD event. In other words, it must include public subroutines named MouseDown, MouseUp, SelectionChange, etc., with the proper number, type and order of parameters.

In principle you can create any number of event handlers with any combination of events you are listening to, yet at any given time due to perfomance considerations TurboCAD cannot connect more than nine events. It's good practice to disconnect events you no longer need before connecting to new ones.

It is recommended to write one class module to implement all event handling you might need and then listen to specific event using an appropriate event mask in ConnectEvents call. A mask can be any combination of event mask constants.


Disconnecting an Event Handler

Once you have established an event connection, your event handler remains connected even after the subroutine that contains the ConnectEvents call has finished running, and you have released your code's references to the event handler object. To disconnect your event handler, you must call the Application object's DisconnectEvents method and pass it the ID value you obtained in ConnectEvents method:

Application.DisconnectEvents idConnection
'Since idConnection is a global, make sure we reset it
idConnection = 0


Working with Microsoft Office VBA

If you have installed any of the applications in Microsoft Office 97 or 2000, you can take advantage of their VBA type libraries and build macros that combine the data and text handling capabilities of Office with TurboCAD's drawing and rendering power. For example, you can build a macro that reads coordinate data from an Excel spreadsheet to build 2D and 3D objects in TurboCAD. You can also export the contents of a TurboCAD drawing to a Microsoft Excel spreadsheet or Microsoft Access database.


Referencing Office Objects in TurboCAD VBA

You can declare and initialize Office objects just as you TurboCAD objects. Make sure that you have the proper libraries referenced before you begin to use them. Add the references to in the Tools - References… menu item. The libraries that were current at the time that this documentation was written were:

  • Microsoft Office 9.0 Object Library
  • Microsoft Word 9.0 Object Library
  • Microsoft Excel 9.0 Object Library
  • Microsoft PowerPoint 9.0 Object Library
  • Microsoft Access 9.0 Object Library
  • Microsoft Outlook 9.0 Object Library

After adding the references, you follow the same steps that you would use to create a TurboCAD variable. Just prefix the object type names with the Office application library you are using. This example shows how to start up an Excel application and open an Excel workbook:

    Dim xlapp As New Excel.Application

    'Test to see if Excel was initialized
    If xlapp Is Nothing Then
        MsgBox "Could not create Excel application object"
        Exit Sub
    End If

    'Open a workbook
    Dim xlbook As Excel.Workbook
    Set xlbook = xlapp.Workbooks.Open("J:\Samples\New\Excel\Contours.xls")

When you're done using the Office application, make sure to release the references to the application and other objects. If you don't do this, you'll use up memory resources on your computer by leaving copies of Excel running that you're no longer using:

    'Release Excel stuff
    Set xlbook = Nothing
    Set xlapp = Nothing

To learn more about programming Microsoft Office products, read the "Microsoft Visual Basic Help" files, accessible from the Help menu of the VBA Editor when you're running an Office application.

The Excel sample included in the SDK shows how you can read from an Excel spreadsheet to build a 3-dimensional contour map in TurboCAD.


Referencing TurboCAD Objects in Microsoft Office VBA

When you are programming VBA macros in a Microsoft Office application, you can invoke TurboCAD as an external application. The steps are the same. First, you add the "TurboCAD 4.1 Programmable Objects" reference. Then create the TurboCAD application object. You should use the Visual Basic CreateObject function to start a separate instance of TurboCAD running:

    Dim tcapp As IMSIGX.Application
    Dim dwg As IMSIGX.Drawing
    Set tcapp = CreateObject("TurboCAD.Application")
    If tcapp Is Nothing Then
        MsgBox "Could not create TurboCAD application"
        Exit Sub
    End If

    'Create a new drawing
    Set dwg = tcapp.Drawings.Add

When done with using TurboCAD, make sure to quit the application and release any references:

    'Release TurboCAD stuff
    Set dwg = Nothing
    tcapp.Quit
    Set tcapp = Nothing

The Excel2 sample shows the same functionality in building a contour map drawing in TurboCAD.


Working with SQL Databases via Microsoft ActiveX Data Objects

Programming the SDK, you can treat TurboCAD as a database. By using Drawing and Graphic properties, you can store, retrieve and search for data in a drawing. You can also link the graphics in a drawing to external databases using a custom property to store the link information. This section will give a brief overview of how you can use Visual Basic for Applications to set up a connection to an external database and to transfer data between TurboCAD and the database using Microsoft ADO.


Setting up the Data Source

Before you can use ADO, you need to provide a data source specification to your database. In our example, we will use an Access .MDB file, but many other types of sources are compatible with ADO. Microsoft and third-party vendors supply the necessary drivers to tie any source of data that can be modeled as rows and columns to the ADO framework.


Adding a Block Attribute To Provide the Data Link

One way to link to external databases is through Block attributes. You can create an attribute named "Dbid" that can hold the primary key id in the database table. You can then write a user form that links the block insertion to a specific database record, and updates the database.


Creating Advanced Projects with the TurboCAD SDK

By using the TurboCAD SDK, and a compiler or environment that knows how to communicate with objects using Microsoft's COM (Component Object Model) API, you can build a wide variety of custom solutions for CAD users. The TurboCAD "engine", comprised of a collection of DLL's and the TurboCAD executable program itself can be customized and extended by special servers that you can write and install. Alternatively you can build your own front-end or user interface and use the TurboCAD engine to load, save, modify and display CAD data in any way you can imagine. You can write standalone applications that run on the Windows operating system, ActiveX controls that can be hosted on a web page or in a Microsoft Office application, and even special custom server components that can combine CAD data with other information to build N-tier solutions in geographic information systems, 3D catalogs, and other enterprise activities.

This section of the TurboCAD SDK documentation will give you the details necessary to build these extensions and solutions, and the numerous examples that come with the SDK provide insight into some of the ways you can build interesting and exciting CAD projects.

IMPORTANT NOTE You will need to obtain an SDK developer license if you intend to build and distribute any project that links to (statically or dynamically) or includes any TurboCAD source code or object code in any way. A sample agreement form can be found here. If you have questions about the terms and limitations of your SDK license, please contact IMSI.


Using Different Development Environments

TurboCAD SDK projects can be built using any compiler that supports the Win32 API, COM (Component Object Model) API and OLE (Object Linking and Embedding) Automation API (in this documentation, we will refer to OLE Automation as "Automation"). The documentation and samples that come with the SDK illustrate how to build projects using the development environments and tools that Microsoft supplies: Visual Basic (version 6.0), Visual C++ (version 6.0), and VBScript (current version is 5.5). Other languages and tools (supplied by Microsoft and other vendors), as well as earlier versions of these compilers and interpreters, can also be used, but will not be supported by IMSI technical support.

Most of the documentation (including the reference pages) for the SDK is directed at the Visual Basic environment, since it is usually the simplest way to create SDK projects. In the sections that follow, special notes for C++ programmers will be indicated by the image ##CPP##, and notes for VBScript programmers will be shown by the image ##VBS##.

The documentation will provide a brief comparison of the differences in syntax, data types, and compiler support between these three development systems. Other details of the differences involved are best explained by looking at the SDK sample code, which is organized by development tool, and by consulting the extensive documentation that Microsoft provides on its developer website at http://msdn.micorosoft.com.


Using Automation Types: Variants, Strings, Objects and Arrays

One of the most key concepts that you will encounter in programming for Automation is the Variant type. This type is used to hold data values in a wrapper object that can handle transferring data across process boundaries, and converting data from and to a variety of formats. In addition to holding standard scalar values (short integer, long integer, floating point, boolean), Variants can also hold dynamic strings (BSTRs), object references, and even dynamically resized arrays of all these types. The Variant type is exposed by the different development systems in subtle ways.


Automation Types in Visual Basic

Since Automation was first introduced to programmers using Visual Basic, the language has extremely flexible features for dealing with variable types. You can choose to strongly type all your variables, declaring them as specific value types, such as Integer, Double, Object, String, etc., or you can leave them untyped, and let Visual Basic perform the necessary type conversions silently for you. For the latter case, Visual Basic provides the Variant type.

Variants

Variant is a key word in Visual Basic. Typically a variable is declared as a Variant with a Dim statement, such as:

Dim v As Variant

Data is transferred into and out of the Variant by assignment:

v = "String"
v = 1

All variables that are not declared as specific types (and all variables that are used without an explicit declaration) are treated as Variants:

Dim untypedVar 'untypedVar is a Variant
undeclaredVar = 2 'undeclaredVar is a Variant

The use of undeclared variables will generate an error if the Option Explicit statement appears in a Visual Basic module, and is generally a bad idea, because it can create confusion about the scope of variable names.

Objects

Object is also a keyword in Visual Basic. An variable declared as Object is in one of two states: either "nothing" or holding a reference to a COM object. Whether the variable contains a reference can be established by the following test:

Dim obj As Object
If obj Is Nothing Then MsgBox "No reference"

Assignment to a variable of the generic Object type (or any specific object type, such as the TurboCAD Drawing type) must be done using the Set statement:

Set obj = CreateObject("TurboCAD.Application.4")

Object references can also be transferred to Variants, again using the Set statement:

Set v = obj

Strings

String is a native type in Visual Basic, so no special processing is necessary:

Dim s as String
s = "Hello, TurboCAD"

Arrays

Multidimensional arrays can be declared with Visual Basic Dim statements, using parentheses to distinguish arrays from scalar values. The size of the array can be fixed at declaration time, or can be resized at any time by leaving the array dimensions unspecified in the declaration, and then using the Visual Basic ReDim statement.

Dim
FixedArrayOfDoubles(10) As Double
Dim ResizeableArrayOfDoubles() As Double
Dim newSize As Integer
newSize = 10
ReDim ResizableArrayOfDoubles(newSize)

Arrays can be assigned to variables of the type Variant:

Dim VariantArrayOfDoubles As Variant
VariantArrayOfDoubles = FixedArrayOfDoubles

And a Variant holding an array can be created and initialized through the Visual Basic Array function:

VariantArrayOfDoubles = Array(1#, 2#, 3#, 4#)

Array elements are accessed through the () operator:

Dim D as Double
D = VariantArrayOfDoubles(0)


Automation Types in Visual C++

##CPP##

As the number of APIs and frameworks that Visual C++ supports has grown over the years, Automation support in Visual C++ comes in many different flavors. You can choose to work with one or more of these flavors, depending on which libraries and frameworks you are using to build your Visual C++ application or add-in. This section will distinguish between the following levels of support:

Win32. This is the basic C-callable Windows API. The Microsoft IDL compiler allows both the COM implementer and user to create and include header files that contain both C and C++ structures and classes that describe the interfaces that you use in COM programming. Using the basic functionality provided by IDL and the Win32 API, developers can build and use any COM object, but they must be extremely careful to observe the strict reference counting, initialization and termination, memory handling and error handling rules that are documented in the COM specification and Win32 API.

Microsoft C++ language extensions and smart pointers. Starting with Visual C++ 5.0, Microsoft added special attributes, keywords and header files that make working with COM objects much simpler and safer than before. The goal was to permit a Visual Basic style of coding, where programmers can make use of "smart pointer" classes that automatically encapsulate much of the boring work of reference counting, interface querying and other monotonous COM tasks. Microsoft has added compiler and linker functionality that can automatically generate these C++ classes from COM type libraries, by the use of the Microsoft-specifc #import statement, and the inclusion of the comdef.h header file.

MFC (Microsoft Foundation Classes). This is the popular C++ application framework introduced by Microsoft to promote wizard-based creation of applications and controls with standard functionality. MFC provides standard, single-inheritance classes that do not make use of templates, and macros that permit relatively easy ways to implement and use Automation objects. MFC also includes a component wizard that creates glue code when using COM dual interfaces and event interfaces specified in type libraries.

ATL (Active Template Library). This C++ framework makes heavy use of C++ templates and multiple inheritance in an effort to produce leaner executables than MFC. ATL and its sister framework, WTL (Windows Template Library), cover much of the same functionality as MFC without the need for large runtime libraries. For this reason, ATL is considered the preferred method for implementing Automation servers and controls in Visual C++.

Variants

Variants are supported at the base Win32 API level through the VARIANT struct. The Win32 API exposes numerous functions and macros for the initializing, assigning, destroying, copying and type-coercing of VARIANT variables.

The VARIANT struct has two members: vt, which determines the type of data held by the VARIANT, and a union which handles the typecasting of the data. VARIANT structs should always be initialized before use by calling the VariantInit function, and memory and object references stored in VARIANTs can be released by calling the VariantClear function. Both VariantInit and VariantClear leave the state of the VARIANT as "empty" (the value of the vt member is VT_EMPTY). Failure to use these functions in the proper order will give your program protection faults and memory leaks.

Another common use of Variants occurs when you are calling an automation method that has optional parameters, as defined in the Visual Basic and IDL interfaces. These parameters are NOT optional when you are calling from C++. Instead you are required to supply a VARIANT struct instance variable (or pointer to a VARIANT) to the method call, in which the vt member value is VT_ERROR, and the scode union member is set to DISP_E_PARAMNOTFOUND.

VARIANTs can be copied using the VariantCopy or VariantCopyInd functions, and can be converted to different types by using the VariantChangeType function. Numerous functions for performing common math, string and other operations using VARIANTs can be found in the Win32 header file oleauto.h.

The VC++ extension to the VARIANT struct is the class variant_t. This class handles most of the memory and type-conversion issues encountered during normal use of variants. variant_t is defined in the comutil.h header file.

MFC also attempts to make the VARIANT struct easy to use by creating an inherited class that automatically performs these setup and conversion chores, called ColeVariant.

The ATL dialect for dealing with Variants is another utility class (simpler and more COM-oriented than its MFC cousin) called CComVariant.

Objects

COM objects in C++ are strictly defined as pointers to an IUnknown interface, which must be supported by every COM object, and handles reference counting and access to other interfaces that the object might expose. In the TurboCAD SDK, all objects support the IDispatch interface (which derives from IUnknown) in addition to their own IDispatch-derived VTBL interface. This means that they are termed "dual" interfaces, meaning that they support late binding and discovery of methods and properties as well as providing fast access to early-bound types through the VTBL. Usually it is unnecessary to use an IUnknown variable type, unless you want to reuse the variable for other purposes. Instead you can use the well-known VTBL interface for better performance.

In C++ or any language that offers access to the Win32 API, you must follow reference counting rules on all object pointers: whenever you get a new object pointer from the Automation system, or from a TurboCAD SDK call, the object pointer that you are given has been reference counted by the system by an internal AddRef method call on the object. Once you have the object's pointer you have control of that object's lifetime. In order to let go of the object properly, you must call the object's Release method when you are no longer interested in the object. Similarly if you need to make a copy of the object, or store it in another variable, you should call the object's AddRef method. Every AddRef call (either internal by the system, or explicitly in your code) must be carefully balanced by a Release call. After the Release call is made, you can no longer be sure the pointer reference is valid.

The other feature of COM objects that the IUnknown interface provides is the ability to "query an interface", that is to find out if the particular object instance referenced by the IUnknown pointer exposes other, derived interfaces. These interfaces are identified by an IID (interface ID), and the QueryInterface method is used to return a pointer (already AddRef'ed) to the derived interface. Any non-null value returned by this method must be properly Released as well.

Visual C++ language extensions to the IUnknown interface are enabled through the use of the #import statement. #import causes the compiler to generate a pair of interface and implementation files that automatically get inserted into your code. These files (with extension .tlh and .tli, respectively) contain wrapper classes that exhibit "smart pointer" semantics to ensure the proper reference counting and query interface rules are applied when you perform common operations such as construction, assignment and "casting" to derived interfaces. The .tlh and .tli files make use of smart pointer macros contained in the comdef.h header file. After adding the #import statement to your source file, using these smart pointers is as easy as declaring an object instance with a standard naming convention. For example, to use a variable that is intended to hold a reference to the TurboCAD IDrawing interface, you can define the variable to be of class IDrawingPtr. The compiler-generated object smart pointer classes also contain methods for creating objects (using the underlying COM CoCreateInstance functions) as well as type conversion and overloaded operators that provide the programmer with the ability to approximate the syntactic simplicity of Visual Basic. These classes also are integrated with the COM error and C++ exception systems, so that errors are properly propagated to the caller. See the Visual C++ documentation for the full details on using the #import statement and smart pointers.

MFC has no easy way to arbitrarily use derived interfaces, but there are wizards that build IDispatch-based linkage.

ATL uses two templates, CComPtr and CComQIPtr, to provide "smart pointer" semantics. In the TurboCAD example shown above, the ATL equivalent is to declare a variable of type CComPtr<IDrawing>. For IDispatch (late binding) access to objects, ATL has the CComDispatchDriver utility class. These are all defined in the atlbase.h header file. Since ATL is primarily used to implement COM objects, there also is a huge amount of template-based class support in ATL for construction, destruction, containment, collection and other features commonly needed by COM implementers.

VARIANTs can be used to hold objects by setting their vt to VT_DISPATCH, and their pdispVal member to point to the object. Again, the variant functions take care of AddRef and Release calls during VariantCopy and VariantClear operations, so be careful not to Release pointers that have been transferred to VARIANTs (or alternatively, make sure that you AddRef them when you do assign them to VARIANTs).

Strings

Automation strings are handled through a Win32 type named BSTR. This is defined as an unsigned short*, and points to either NULL or a system allocated, counted buffer of 16-bit UNICODE characters. Because BSTRs can be created by and passed to any thread or process, and because they contain length information in the four bytes preceding the BSTR pointer itself, all memory allocation, reallocation and deallocation of BSTRs must be done through Win32 functions defined in the oleauto.h header file: SysAllocString, SysAllocStringLen, SysReAllocString, SysReAllocStringLen and SysFreeString. The length of a BSTR can be retrieved by using the SysStringByteLen or SysStringLen functions, (depending on whether you need the number of bytes or UNICODE chars that the string contains). Since BSTRs are required to be UNICODE, you can either select UNICODE as the default for your C++ program, or use development tools that convert between ANSI (single and double byte characters, or "multibyte" characters) to and from UNICODE (wide characters). The low-level Win32 conversion functions are named MultiByteToWideChar and WideCharToMultiByte, and are defined in winnls.h. These somewhat complicated conversion functions are wrapped by macros and inline functions such as W2A, A2W and A2BSTR that perform temporary stack-based allocation and deallocation, BSTR allocation, and also supply standard parameters. You can find these macros in the ansiapi.h header file.

The VC++ extension to the BSTR type is the class bstr_t. As expected, this class handles most of the memory and type-conversion issues encountered during normal use of strings.

In MFC, the CString class encapsulates BSTR conversions and creation, using ANSI or UNICODE strings as the contained data, depending on the compiler switch.

In ATL, the CComBSTR wrapper class is a thin wrapper around the BSTR type and utility functions. Just to be redundant, ATL has its own set of W2A family macros defined in the atlconv.h header file.

ATL supplies macros that you can use to convert between UNICODE wide characters and ANSI characters.

VARIANT structures can hold strings by setting their vt member to VT_BSTR, and setting the bstrVal member to point to the BSTR. The variant functions will properly copy and release memory for BSTRs, so be careful not to call SysFreeString on a pointer that has be passed to a VARIANT which has subsequently been cleared by VariantClear. Similar ownership rules for strings apply to the variant wrapper classes supplied by the frameworks.

Arrays

Automation arrays are manipulated using the SAFEARRAY struct in the Win32 API and associated functions found in oleauto.h, primarily: SafeArrayCreate, SafeArrayDestroy, SafeArrayRedim, SafeArrayGetElement, SafeArrayPutElement, SafeArrayAccessData, andSafeArrayUnaccessData.

MFC wraps some SAFEARRAY functionality in the COleSafeArray class, defined in afxdisp.h.

There is no support for SAFEARRAY currently exposed by the Visual C++ extensions or ATL.

Arrays can also be assigned to VARIANT variables, through the use of the flag VT_ARRAY which is added to the scalar type specified in the vt member. When the vt member has the VT_ARRAY flag set, the parray union member is expected to point to a valid SAFEARRAY pointer. Arrays passed as VARIANTs to TurboCAD SDK functions are typically set up as follows:

VARIANT variantArrayOfDoubles;
VariantInit(&variantArrayOfDoubles);       // Good practice to always do this
variantArrayOfDoubles.vt = VT_ARRAY|VT_R8; // Type is "array of doubles"

// Set up an empty (length 0) array of doubles
// Describe the (only) dimension of the array
SAFEARRAYBOUND bound;
bound.cElements = 0; // Empty array
bound.lLbound = 0;   // By convention all arrays should be zero-based
variantArrayOfDoubles.parray = SafeArrayCreate(VT_R8, 1, &bound);

if (SUCCEEDED(pObject->SomeFunctionTakingAVariant(&variantArrayOfDoubles)))
{
    // Now try to extract an element
    double d = 0; // where to store result
    long lIndex = 0;
    SafeArrayGetElement(variantArrayOfDoubles.parray, &lIndex, (void**)&d);
}

// Always release VARIANT memory when done
// VariantClear will call SafeArrayDestroy internally
VariantClear(&variantArrayOfDoubles);


Automation Types in VBScript

##VBS##

VBScript is scripting language developed by Microsoft that bears syntax similarities to Visual Basic. VBScript is commonly used for client-side and server-side programming on HTML pages, and is also supported by the Windows Scripting Host, a programming environment that is part of standard Windows installations. VBScript, like most other script languages is "typeless", but supports conversion between a number of built-in "subtypes" such as Integer, String and Object. VBScript also supports the ability to reference COM object types and interfaces at runtime.

Variants

Every variable in VBScript is a Variant. You declare variables using the Dim statement, but unlike the typing system in Visual Basic, you don't specify a type:

Dim myVar
myVar = 2
myVar = "now I'm a string"

Objects

Just as in Visual Basic, you can create objects using the CreateObject function, and create references to them using the Set statement. Since variables in VBScript are untyped, you can find out if a variable holds an object reference using the VarType statement.

Dim myVar
Set myVar = CreateObject("IMSIGX.Application")
MsgBox "myVar is a " & VarType(myVar)

Strings

Strings are treated as in Visual Basic as a built-in subtype.

Arrays

Arrays are declared similarly to Visual Basic, and can be of fixed or dynamic size. The Dim and Redim statements are used to declare and resize array types.


Using the Application, Drawing and View Objects

The contents of this section will discuss some of the details you need to be aware of when using the TurboCAD Application, Drawing and View objects in your applications.


Creating an Application Object in In-Process and Out-Of-Process Servers

The TurboCAD Application object can be created as an in-process (DLL) server, in a custom client application's process with a user interface provided by the client application. In this way you can read files, create drawings, add, modify and delete graphics, and display drawings on your application's user-defined viewports.

The TurboCAD Application object can also be created as a local (EXE) server. In this scenario the objects are provided by the TurboCAD engine, and your client can control and customize the operation of TurboCAD, adding user interface elements, receiving events fired by TurboCAD, and extending the operation of TurboCAD. If TurboCAD has been launched by a user, your client application can also connect to the active running instance of TurboCAD.

In general, in-process servers run faster than local servers. The in-process server is contained in IMSIGX<xx>.DLL (where xx - DLL version number, e.g. 70), together with support from DBAPI<xx>.DLL, TCAPI<xx>.DLL, and a variety of graphic regeneration method and drawing file format filter DLLs. Use the local server option when you require TurboCAD's user interface (menus, toolbars and windows).

The in-process and local servers have distinct ProgIDs and CLSIDs, so make sure you use the correct string when you create a TurboCAD Application object. After locating the server the system starts up the server and requests an object.

Creating an Application Object in Visual Basic

Unless you work with TurboCAD VBA, you may need to explicitly set a reference to the TurboCAD type library to create a TurboCAD Application object in your custom application. The type library is contained in the IMSIGX70.DLL file typically found in the Program subdirectory of your TurboCAD installation. If it has been registered correctly, the type library will will appear in Visual Basic's References dialog as "TurboCAD v4.1 Programmable Objects". If it has not been registered, you will need to browse to the IMSIGX70.DLL file to add the reference.

Then to create an Application object, the statements:

Dim app As IMSIGX.Application
Set app = CreateObject(, "IMSIGX.Application")

will start up the in-process (DLL) server, and the statements:

Dim app As TurboCAD.Application
Set app = CreateObject(, "TurboCAD.Application")

will start up the local (or out-of-process, EXE) server.

You may also use the As New syntax to create the Application object:

Dim app As New TurboCAD.Application

You can also connect to a running instance of TurboCAD (as an out-of-process server by using the GetObject function:

Dim app As TurboCAD.Application
Set app = GetObject("TurboCAD.Application")

GetObject will return a Nothing reference if TurboCAD is not running on the same machine as the calling Visual Basic application.

Creating an Application Object in C++

##CPP##

In C++ or other languages that allow direct calls to the Win32 API, the choice between in-process and local servers is also determined by the dwClsContext argument to the CoCreateInstance or CoCreateInstanceEx functions, as well as the CLSID values passed. CLSID_XApplication refers to the in-process server, and CLSID_Application refers to the out-of-process server. For example,

IApplication* pIApp = NULL;
HRESULT hr = CoCreateInstance(CLSID_XApplication, NULL, CLSCTX_INPROC_SERVER, IID_IApplication, (void**)&pIApp);

will start up the in-process (DLL) server, while

HRESULT hr = CoCreateInstance(CLSID_Application, NULL, CLSCTX_LOCAL_SERVER, IID_IApplication, (void**)&pIApp);

will start up the local (EXE) server.

When you use the Visual C++ extension syntax and smart pointers, it is usually easier to specify the appropriate ProgID (a string which is used by the COM system to look up the correct CLSID for the server), assuming that all the type libraries have been correctly registered. In addition, you must specify the correct creation context. "IMSIGX.Application" is the ProgID used for the in-process server (which corresponds to CLSID_XApplication), and "TurboCAD.Application" is the ProgID used for the out-of-process server (which corresponds to CLSID_Application). Consult these examples:

#import "imsigx.tlb"

HRESULT hr;
IMSIGX::IApplicationPtr spIApp;
hr = spIApp.CreateInstance("IMSIGX.Application", NULL, CLSCTX_INPROC_SERVER); // in-process
hr = spIApp.CreateInstance("TurboCAD.Application", NULL, CLSCTX_LOCAL_SERVER); // local server

In ATL, you accomplish the same thing with:

HRESULT hr;
CComPtr<IApplication> spIApp;
hr = spIApp.CoCreateInstance(L"IMSIGX.Application", NULL, CLSCTX_INPROC_SERVER);
hr = spIApp.CoCreateInstance(L"TurboCAD.Application", NULL, CLSCTX_LOCAL_SERVER);

Creating an Application Object in VBScript

##VBS##

To create a VBScript object that gives access to the TurboCAD in-process application object, you use the CreateObject constructor, passing the appropriate ProgID string:

Dim app
Set app = CreateObject("IMSIGX.Application"
WScript.Echo "in_proc"
If app Is Not Nothing Then WScript.Echo " version " & app.Version


Destroying the In-Process or Out-of-Process Application Object

If you have created a TurboCAD Application object as in-process server it will be automatically destroyed when last reference to it is destroyed:

Dim app as New IMSIGX.Application
'Work with Application object
Set app = Nothing 'VB implicitly does this when variable goes out of scope

However, in case of an out-of-processes server releasing reference to the object variable holding the Application object will not close TurboCAD itself. To close the TurboCAD itself you need to use Quit method of the Application object:

Set app = CreateObject("TurboCAD.Application")
'Work with Application object
app.Quit
Set app = Nothing

##CPP##

In C++, you must follow the same rules. If you're programming directly to the Win32 API, you must release your application object reference explicitly. In addition, you must force the out-of-process (EXE) server to quit properly.

In-process server example:

pIApp->Release();
pIApp = NULL;

Out-of-process server example:

hr = pIApp->Quit();
pIApp->Release();
pIApp = NULL;

The smart pointers provided by MFC and ATL automatically do the reference releasing for you when the variables go out of scope, or when you set their value to NULL explicitly. You must still call the Quit method for the out-of-process server, however.

##VBS##

In VBScript, you can release the Application object reference explicitly by setting the variable value to null. Again, don't forget to call the Application object's Quit method if you're using an out-of-process server:

app.Quit  'only needed for out-of-process servers
Set app = Nothing 'VBScript does this for you when variable goes out of scope


Creating A TurboCAD Drawing Using CreateObject

Similarly to how you create an Application object, you can use object creation methods to create TurboCAD Drawing objects. In standard OLE andCOM terms, the Drawing object is a document. When you create a document using CreateObject (in Visual Basic), CoCreateInstance (in C++) or new ActiveXObject (in VBScript), the TurboCAD engine will automatically force the creation of an Application object, which will then be called upon to create the Drawing object that is returned to you. Hence the discussion on creating Application objects also applies to this method of creating Drawing objects. If you are primarily interested in creating new drawings, and don't care about methods on the Application object, this can be used as a shortcut:

Dim dwg As Object
Set dwg = CreateObject(, "TurboCAD.Drawing")

All examples discussed for creating and accessing Application objects can be easily modified to create Drawing objects by replacing "IMSIGX.Application" with "IMSIGX.Drawing" or CLSID_Application with CLSID_Drawing.

If you don't explicitly create an Application object, the server will shut down when all of the Drawing and other references you create go out of scope or are explicitly released. In the out-of-process server case, you should still call the Application object's Quit method.

Is this correct? Verify with a test program.


Saving Drawings

A backup copy of the drawing file, as well as summary info and preview are created for a drawing only if the TurboCAD application runs in out-of-process server mode. If you want backup copies made for in-process servers, it is up to you as the programmer to call the Drawing object's SaveAs method.


Closing a Drawing

The Drawing.Close method takes an optional Boolean parameter named SaveChanges. The SaveChanges parameter works only when TurboCAD Application is run in local server mode. If this parameter evaluates to True, TurboCAD will check if the drawing has been modified since last save, and if it has, will display a Save Changes dialog box will be presented. If the drawing is a new one that has not yet been saved to disk as a file, clicking the Yes button in the dialog box will open a Save As dialog box.


Using View Objects

Each drawing created in TurboCAD when it runs in out-of-process server mode has at least one default view.

In a standalone application that uses TurboCAD engine as in-process server (i.e. as COM or ActiveX component) a newly created Drawing object will not have default View object associated with it. To be able to display a Drawing object in a window or to be able to output it to a printing or any other device, you need to create a View associated with this Drawing object and specify its properties (see below).

After you have created a View object you can access it using the Drawing object's View collection. You need to keep track of each View hWnd or hDC property, since it is the only way to identify a unique view in an application.

If you plan to use VBA to create your standalone application (for instance to access TurboCAD from MS Excel spreadsheet or MS Access database as an in-process server), you might find it problematic to display a TurboCAD drawing in a VBA form or control (see the Using The View Object topics in the Exploring in Depth section). A preferable approach would be to create a custom hWnd-aware ActiveX control using C++, VB, or any other development language to display a TurboCAD drawing in a standalone VBA application.

After you have finished with a View you have created, you may destroy it using the Delete method. You should never destroy intrinsic TurboCAD View objects (those not created by your own explicit code). However, you can safely destroy View objects that you have created by the Add method of the Views collection.


Managing Active Drawings and Views

If the TurboCAD engine is accessed as in-process server in your custom application, you need to take care of creating or using control windows, and then creating and attaching View objects in which you can display TurboCAD drawings. In this case TurboCAD knows nothing of a currently active drawing object, i.e. it's up to you to determine which drawing window is considered as active. The TCADX sample project shows one way to maintain these attachments.

In the out-of-process server case, the TurboCAD EXE application keeps track of which drawing and view has the focus, and updates the ActiveDrawing and ActiveView properties for you.


Handling TurboCAD Events

TurboCAD fires a set of events at predetermined times that you can receive by writing an Automation client that can be written using any Automation-compatible development system. These events indicate to a client of the TurboCAD engine when specific actions are about to occur, or when they have finished. For example when you make a change to the selection, the TurboCAD engine fires a "SelectionChange" event, and passes information about the location and contents of the selection back to the client.

The client, often called an "event sink" in Microsoft documentation, can receive any or all of the predefined events that are documented in the SDK reference. By trapping these events, your client application or ActiveX control can keep track of TurboCAD's current drawing, the current selection, the currently running tool, etc., and keep any data structures or user interface features in your client up to date.

You can choose to handle any subset of the full suite of 31 available events by specifying a number called the "event mask", which is the sum of the following constants:

              imsiEventBeforeExit = 1
              imsiEventDrawingNew = 2
              imsiEventDrawingOpen = 4
              imsiEventDrawingActivate = 8
              imsiEventDrawingDeactivate = 16
              imsiEventDrawingBeforeClose = 32
              imsiEventDrawingBeforeSave = 64
              imsiEventWindowResize = 128
              imsiEventWindowActivate = 256
              imsiEventWindowDeactivate = 512
              imsiEventMouseDown = 1024
              imsiEventMouseUp = 2048
              imsiEventMouseMove = 4096
              imsiEventBeforeDoubleClick = 8192
              imsiEventBeforeRightClick = 16384
              imsiEventSelectionChange = 32768
              imsiEventCommandBarControlHit = 65536
              imsiEventCommandBarControlStatus = 131072
              imsiEventRunTool = 262144
              imsiEventPointSnapped = 524288
              imsiEventPointPick = 1048576
              imsiEventRectanglePick = 2097152
              imsiEventPolygonPick = 4194304
              imsiEventViewBeforeRedraw = 8388608
              imsiEventViewAfterRedraw = 16777216
              imsiEventVirtualIntersectionPick = 33554432
              imsiEventCommandBarControlDone = 67108864
              imsiEventDrop = 134217728
              imsiEventCancel = 268435456
              imsiEventUpdateUndo = 536870912
              imsiEventDrawingAfterSave = 1073741824


Handling TurboCAD Events in Visual Basic Projects

To handle TurboCAD events in Visual Basic, you must first create a class module (CLS file) or form (FRM file). When you create a class module or form, Visual Basic exposes the class module or form's methods and properties through the IDispatch Automation interface that is required to connect and handle events.

To create a class module to hande TurboCAD events, choose Add | Class Module in the VB Editor, and name the new class module "modEvents".

Then add the necessary event handler methods (as public subroutines) to your class module. You only need to add the handlers for the events you want to receive. Make sure that the methods you do define exactly match the names and parameters listed below:

Public Sub BeforeDoubleClick(ByVal WhichDrawing As IMSIGX.IDrawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Sel As IMSIGX.Selection, Cancel As IMSIGX.IMSI_BOOL)
Public Sub BeforeExit(ByVal TheApp As IMSIGX.IApplication, Cancel As IMSIGX.IMSI_BOOL)
Public Sub BeforeRightClick(ByVal WhichDrawing As IMSIGX.IDrawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Sel As IMSIGX.Selection, Cancel As IMSIGX.IMSI_BOOL)
Public Sub DrawingActivate(ByVal WhichDrawing As IMSIGX.IDrawing)
Public Sub DrawingAfterSave(ByVal WhichDrawing As IMSIGX.IDrawing)
Public Sub DrawingBeforeClose(ByVal WhichDrawing As IMSIGX.IDrawing, Cancel As IMSIGX.IMSI_BOOL)
Public Sub DrawingBeforeSave(ByVal WhichDrawing As IMSIGX.IDrawing, SaveAs As IMSIGX.IMSI_BOOL, Cancel As IMSIGX.IMSI_BOOL)
Public Sub DrawingDeactivate(ByVal WhichDrawing As IMSIGX.IDrawing)
Public Sub DrawingNew(ByVal WhichDrawing As IMSIGX.IDrawing)
Public Sub DrawingOpen(ByVal WhichDrawing As IMSIGX.IDrawing)
Public Sub Drop(ByVal WhichDrawing As IMSIGX.IDrawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Sel As IMSIGX.Selection)
Public Sub MouseDown(ByVal WhichDrawing As IMSIGX.IDrawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Button As IMSIGX.ImsiMouseButton, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long, Cancel As IMSIGX.IMSI_BOOL)
Public Sub MouseMove(ByVal WhichDrawing As IMSIGX.IDrawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long, Cancel As IMSIGX.IMSI_BOOL)
Public Sub MouseUp(ByVal WhichDrawing As IMSIGX.IDrawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Button As IMSIGX.ImsiMouseButton, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long, Cancel As IMSIGX.IMSI_BOOL)
Public Sub RunTool(ByVal WhichTool As IMSIGX.Tool)
Public Sub SelectionChange(ByVal WhichDrawing As IMSIGX.IDrawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Sel As IMSIGX.Selection)

Check for missing signatures

After you have saved the class module, edit your project's main module. Declare and construct an instance of your event handling class module in a global variable. Use the As New syntax to create the instance in a variable called eventHandler as follows (assuming your class module is named modEvents):

Private eventHandler As New modEvents

By creating a global variable and using the As New syntax, Visual Basic will only create your instance when it is first used, and will keep the single instance in memory for as long as your application is running.

Finally, after you have connected to the TurboCAD engine's Application object, you signal that you are ready to receive events, by invoking the Application's ConnectEvents method. The Mask parameter tells the TurboCAD engine which events to send your client. There is a const number for each event. You add them together to generate the mask. For example:

Dim app As IMSIGX.Application
Set app = CreateObject(, "IMSIGX.Application")
Dim eventMask As Long
eventMask = imsiEventMouseDown + imsiEventMouseUp
Dim eventId As Long
' Start handling mouse down and mouse up events
eventId = app.ConnectEvents(eventHandler, eventMask)

After the connection to your handler class module has been established, your class module's handler methods will be called whenever the particular event is fired. In the example above, the module's MouseDown and MouseUp subroutines will be the only ones called, because of the value passed as the Mask parameter to ConnectEvents. When you want to stop handling events, you call the Application object's DisconnectEvents method, and pass in the eventId that tells the Application which handler is being disconnected:

' We're finished with events
app.DisconnectEvents eventId

The TCADX example project illustrates this connection process in more detail.


Handling TurboCAD Events in Visual C++ Projects

##CPP##

This document will describe in step-by-step detail how to write an event sink application using Microsoft Visual C++ 4.0 or later, using the Microsoft Foundation Classes (MFC) framework, with additional support for the Automation dual interface. Using dual interfaces will permit better performance in future releases of the TurboCAD SDK, and is very easy to implement using two helper files provided by Microsoft. Other development systems (such as VC++ and the ActiveX Template Library), or straight C or C++ Windows and COM SDK programming can accomplish the same task.

Components

Using MFC, the Events demo application source code was generated using the following steps:

AppWizard created an Automation-enabled, dialog-based MFC EXE, together with the source files for the CWinApp derived main application class, CTCEventsApp, and the main dialog class, CTCEventsDlg, as well as standard make files, resource files, etc.

ClassWizard was then used to add automation properties and methods to the CTCEventsApp class. In this way, skeleton code was added to Events.h, Events.cpp and the Events.odl interface definition file.

Controls were added to the CTCEventsDlg dialog using the Visual C++ dialog editor, and button click handlers were added using ClassWizard. A message handler was added by hand, to process the checkbox notification messages sent by the event mask checkboxes.

Support for Automation dual interface was added to CTCEventsApp class, using macros provided in MfcDual.h.

What the Events Demo Application Does

The demo application is designed to monitor TurboCAD. When executed, it presents a dialog to the user. By pressing the "Connect to Events" button, the application will try to connect to an active running instance of TurboCAD , or if none is active, it will start up TurboCAD, using the COM system call CoCreateInstance. After the application object is successfully attached, a call to a TurboCAD SDK method, IApplication::ConnectEvents, passes the IDispatch pointer of our client application to TurboCAD, allowing TurboCAD to send us events. After establishing the connection, the button's caption will change to "Disconnect."

ConnectEvents takes a Mask parameter that tells TurboCAD what subset of the full event suite we are interested in. This mask is set up by the state of the checkboxes on the dialog. To monitor a particular event, check the control with its name. To stop monitoring the event, uncheck the corresponding control. If the event connection has already been made, each check and uncheck will disconnect and establish a new connection with the new mask. Pressing the "Disconnect" button forces a disconnect. Pressing "Exit Application" disconnects both the event monitor, and forces TurboCAD to shut down. Pressing "Close" cleans up the connection if open, and closes the dialog.

As events are fired, they are passed to the client application's IDispatch pointer through Automation. Each event received is processed by a separate handler function, which sends a Windows message to the edit control on the dialog to append a line of text describing the event. A real event handler would update its data structures or present some user interface that might interact with TurboCAD.

AppWizard, ClassWizard and MFC's Automation Support

Review this for applicability to VC++ 6.

The version of AppWizard that ships with Visual C++ is somewhat constrained in its support for enabling Automation. Normally, the only class that it enables is the CDocument derived class, and this is only set up correctly, if you choose a non-dialog-based application. In fact you can add full MFC and ClassWizard Automation support to any class that derives from CCmdTarget. In our case, in order to keep the number of files small and the design simple, and since we did not intend to create documents or views, we chose a dialog-based application, and then manually jump-started the ClassWizard to allow us to Automation enable our application class. The steps we had to take were as follows:

Edit the .odl file.

Edit the CTCEvents.h file.

Edit the CTCEvents.cpp file.

Now the CTCEvents class can take advantage of ClassWizard to add properties and methods. We used ClassWizard to mimic the TurboCAD SDK's IAppEvents interface, substituting LPDISPATCH parameters for TurboCAD interfaces, and BOOL parameters for TurboCAD's IMSI_BOOL. Using ClassWizard has the advantage of maintaining the .odl, .h and .cpp files through a (relatively) simple user interface.

Making Your Project a TurboCAD Event Sink

To add a TurboCAD event sink to any CCmdTarget derived class, take the following steps.

Copy the following lines verbatim from CTCEvents.h into the header file for your CCmdTarget-derived class (we'll call it CTCMonitor). These are the member functions that your class must implement in order to process TurboCAD events:

// Generated OLE dispatch map functions
//{{AFX_DISPATCH(CTCMonitor)
afx_msg void BeforeExit(LPDISPATCH TheApp, BOOL FAR* Cancel);
afx_msg void DrawingNew(LPDISPATCH WhichDrawing);
afx_msg void DrawingOpen(LPDISPATCH WhichDrawing);
afx_msg void DrawingActivate(LPDISPATCH WhichDrawing);
afx_msg void DrawingDeactivate(LPDISPATCH WhichDrawing);
afx_msg void DrawingBeforeClose(LPDISPATCH WhichDrawing, BOOL FAR* Cancel);
afx_msg void DrawingBeforeSave(LPDISPATCH WhichDrawing, BOOL FAR* SaveAs, BOOL FAR* Cancel);
afx_msg void WindowResize(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow);
afx_msg void WindowActivate(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow);
afx_msg void WindowDeactivate(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow);
afx_msg void MouseDown(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y);
afx_msg void MouseUp(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y);
afx_msg void MouseMove(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, long Shift, long X, long Y);
afx_msg void BeforeDoubleClick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel, BOOL FAR* Cancel);
afx_msg void BeforeRightClick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel, BOOL FAR* Cancel);
afx_msg void SelectionChange(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel);
afx_msg void CommandBarControlHit(LPDISPATCH WhichControl, BOOL FAR* Cancel);
afx_msg void CommandBarControlStatus(LPDISPATCH WhichControl);
afx_msg void RunTool(LPDISPATCH WhichTool);
afx_msg void PointSnapped(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, long XScreen, long YScreen, LPDISPATCH PointRaw, LPDISPATCH PointSnapped);
afx_msg void PointPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled);
afx_msg void RectanglePick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled);
afx_msg void PolygonPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled);
afx_msg void ViewBeforeRedraw(LPDISPATCH WhichDrawing, LPDISPATCH WhichView);
afx_msg void ViewAfterRedraw(LPDISPATCH WhichDrawing, LPDISPATCH WhichView);
afx_msg void VirtualIntersectionPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH PickResult, BOOL WasCanceled);
afx_msg void CommandBarControlDone(LPDISPATCH WhichControl);
afx_msg void Drop(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Selection);
//}}AFX_DISPATCH
DECLARE_DISPATCH_MAP()
DECLARE_INTERFACE_MAP()

Check for missing signatures

Copy the following lines verbatim into your CCmdTarget-derived implemenation (.cpp) file. This "dispatch map" is used by MFC to perform late binding via the IDispatch::Invoke mechanism, so that the member functions get called with the correct parameters:

BEGIN_DISPATCH_MAP(CTCMonitor, CCmdTarget)
//{{AFX_DISPATCH_MAP(CTCMonitor)
DISP_FUNCTION(CTCMonitor, "BeforeExit", BeforeExit, VT_EMPTY, VTS_DISPATCH VTS_PBOOL)
DISP_FUNCTION(CTCMonitor, "DrawingNew", DrawingNew, VT_EMPTY, VTS_DISPATCH)
DISP_FUNCTION(CTCMonitor, "DrawingOpen", DrawingOpen, VT_EMPTY, VTS_DISPATCH)
DISP_FUNCTION(CTCMonitor, "DrawingActivate", DrawingActivate, VT_EMPTY, VTS_DISPATCH)
DISP_FUNCTION(CTCMonitor, "DrawingDeactivate", DrawingDeactivate, VT_EMPTY, VTS_DISPATCH)
DISP_FUNCTION(CTCMonitor, "DrawingBeforeClose", DrawingBeforeClose, VT_EMPTY, VTS_DISPATCH VTS_PBOOL)
DISP_FUNCTION(CTCMonitor, "DrawingBeforeSave", DrawingBeforeSave, VT_EMPTY, VTS_DISPATCH VTS_PBOOL VTS_PBOOL)
DISP_FUNCTION(CTCMonitor, "WindowResize", WindowResize, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH)
DISP_FUNCTION(CTCMonitor, "WindowActivate", WindowActivate, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH)
DISP_FUNCTION(CTCMonitor, "WindowDeactivate", WindowDeactivate, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH)
DISP_FUNCTION(CTCMonitor, "MouseDown", MouseDown, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_I2 VTS_I4 VTS_I4 VTS_I4)
DISP_FUNCTION(CTCMonitor, "MouseUp", MouseUp, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_I2 VTS_I4 VTS_I4 VTS_I4)
DISP_FUNCTION(CTCMonitor, "MouseMove", MouseMove, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_I4 VTS_I4 VTS_I4)
DISP_FUNCTION(CTCMonitor, "BeforeDoubleClick", BeforeDoubleClick, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_PBOOL)
DISP_FUNCTION(CTCMonitor, "BeforeRightClick", BeforeRightClick, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_PBOOL)
DISP_FUNCTION(CTCMonitor, "SelectionChange", SelectionChange, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH)
DISP_FUNCTION(CTCMonitor, "CommandBarControlHit", CommandBarControlHit, VT_EMPTY, VTS_DISPATCH VTS_PBOOL)
DISP_FUNCTION(CTCMonitor, "CommandBarControlStatus", CommandBarControlStatus, VT_EMPTY, VTS_DISPATCH)
DISP_FUNCTION(CTCMonitor, "RunTool", RunTool, VT_EMPTY, VTS_DISPATCH)
DISP_FUNCTION(CTCMonitor, "PointSnapped", PointSnapped, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_I4 VTS_I4 VTS_DISPATCH VTS_DISPATCH)
DISP_FUNCTION(CTCMonitor, "PointPick", PointPick, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_BOOL)
DISP_FUNCTION(CTCMonitor, "RectanglePick", RectanglePick, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_BOOL)
DISP_FUNCTION(CTCMonitor, "PolygonPick", PolygonPick, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_BOOL)
DISP_FUNCTION(CTCMonitor, "ViewBeforeRedraw", ViewBeforeRedraw, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH)
DISP_FUNCTION(CTCMonitor, "ViewAfterRedraw", ViewAfterRedraw, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH)
DISP_FUNCTION(CTCMonitor, "VirtualIntersectionPick", VirtualIntersectionPick, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_BOOL)
DISP_FUNCTION(CTCMonitor, "CommandBarControlDone", CommandBarControlDone, VT_EMPTY, VTS_DISPATCH)
DISP_FUNCTION(CTCMonitor, "Drop", Drop, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH)
//}}AFX_DISPATCH_MAP
END_DISPATCH_MAP()

Check for missing signatures

static const IID IID_IAppEvents =
{ 0x6A481301, 0xE531, 0x11CF, { 0xA1, 0x15, 0x0, 0xA0, 0x24, 0x15, 0x8D, 0xAF } };
BEGIN_INTERFACE_MAP(CTCMonitor, CCmdTarget)
INTERFACE_PART(CTCMonitor, IID_IAppEvents, Dispatch)
END_INTERFACE_MAP()

Copy the event sink member function implementations into the same file, and then add your own implementations. For example:

void CTCMonitor::BeforeExit(LPDISPATCH TheApp, BOOL FAR* Cancel)
{
// Do something here
}

The .odl file is not strictly necessary, since the IID_IAppEvents interface ID is defined in, and registered with, the TurboCAD SDK.

Make sure to include "GxIntf.h" and "IMSIGx.h" header files (which define IID_IAppEvents).

Call CCmdTarget::EnableAutomation in your object's constructor, or any place in your code before you make the IApplication::ConnectEvents call to TurboCAD. See the Events.cpp source file for more details.

Use CCmdTarget::GetIDispatch(TRUE) to obtain the LPDISPATCH pointer to pass to TurboCAD in ConnectEvents. See the EventDlg.cpp source file for more details.

Support for Dual Interfaces in MFC

Two additional files, MfcDual.h and MfcDual.cpp, extend the Automation support offered in Visual C++ to include support for dual interfaces. Dual interfaces permit Automation clients to short cut the IDispatch::Invoke method and call servers more directly (in the case of an in-process server) via a function pointer, resulting in a performance increase. Even though there is not much to gain in the case of local server communication (as in our case, where the demo application and TurboCAD are in effect both local servers), we added this dual interface support to show how it's done. For more information, see the MFC Technical Note 65, "TN065: Dual-Interface Support for OLE Automation Servers".

ATL samples?


Handling TurboCAD Events using VBScript

##VBS##

In VBScript you can declare classes. To handle TurboCAD events in VBScript, you declare a class (we'll name it TCEvents) and define the handler methods as functions. You must name the functions and list the parameters exactly as given below, although you only need to define functions for those events you intend to handle:

class TCEvents
public function BeforeExit(TheApp, Cancel)
public function DrawingNew(WhichDrawing)
'put your handler code here
public function DrawingOpen(WhichDrawing)
'put your handler code here
public function DrawingActivate(WhichDrawing)
'put your handler code here
public function DrawingDeactivate(WhichDrawing)
'put your handler code here
public function DrawingBeforeClose(WhichDrawing, Cancel)
'put your handler code here
public function DrawingBeforeSave(WhichDrawing, SaveAs, Cancel)
'put your handler code here
public function WindowResize(WhichDrawing, WhichView, WhichWindow)
'put your handler code here
public function WindowActivate(WhichDrawing, WhichView, WhichWindow)
'put your handler code here
public function WindowDeactivate(WhichDrawing, WhichView, WhichWindow)
'put your handler code here
public function MouseDown(WhichDrawing, WhichView, WhichWindow, Button, ShiftKeys, X, Y)
'put your handler code here
public function MouseUp(WhichDrawing, WhichView, WhichWindow, Button, ShiftKeys, X, Y)
'put your handler code here
public function MouseMove(WhichDrawing, WhichView, WhichWindow, ShiftKeys, X, Y)
'put your handler code here
public function BeforeDoubleClick(WhichDrawing, WhichView, WhichWindow, Sel, Cancel)
'put your handler code here
public function BeforeRightClick(WhichDrawing, WhichView, WhichWindow, Sel, Cancel)
'put your handler code here
public function SelectionChange(WhichDrawing, WhichView, WhichWindow, Sel)
'put your handler code here
public function CommandBarControlHit(WhichControl, Cancel)
'put your handler code here
public function CommandBarControlStatus(WhichControl)
'put your handler code here
public function RunTool(WhichTool)
'put your handler code here
public function PointSnapped(WhichDrawing, WhichView, XScreen, YScreen, PointRaw, PointSnapped)
'put your handler code here
public function PointPick(WhichDrawing, WhichView, Result, PickWasCanceled)
'put your handler code here
public function RectanglePick(WhichDrawing, WhichView, Result, PickWasCanceled)
'put your handler code here
public function PolygonPick(WhichDrawing, WhichView, Result, PickWasCanceled)
'put your handler code here
public function ViewBeforeRedraw(WhichDrawing, WhichView)
'put your handler code here
public function ViewAfterRedraw(WhichDrawing, WhichView)
'put your handler code here
public function VirtualIntersectionPick(WhichDrawing, WhichView, PickResult, PickWasCanceled)
'put your handler code here
public function CommandBarControlDone(WhichControl)
'put your handler code here
public function Drop(WhichDrawing, WhichView, WhichWindow, Selection)
'put your handler code here
end class

Check for missing signatures

The event handling class is instantiated and connected to the Application object in much the same way as in Visual Basic. See the HtmlScriptPack example project for more information.


Building Standalone Custom TurboCAD Applications

Using the TurboCAD SDK, it is easy to build small applications that give users the ability to use simple subsets of TurboCAD's functionality. The SDK contains some simple examples of how you can "write your own CAD program." You can easily add sophisticated editing, interaction with databases, and other features to build applications and controls that can be tailored for specific uses.

NOTE If you are interested in selling or otherwise distributing custom applications built with the SDK, you must obtain a developer license from IMSI. A sample agreement form can be found here. If you have questions about the terms and limitations of your SDK license, please contact IMSI.

Building CAD Programs Using Visual Basic

The TCADX and Preview Visual Basic example projects give a quick introduction on how you can interact with Drawing and View objects using a Visual Basic Form that contains a PictureBox control. The PictureBox's client window is used to connect to the TurboCAD View object, and mouse clicks in the PictureBox are intercepted and used to select, move or modify drawing contents.

To create a new project for making a standalone TurboCAD application in Visual Basic, make sure to follow these steps:

  • Choose "??" as your project type
  • Reference the TurboCAD type library
  • Other build and project settings?
  • Add your code
  • Compile your application
  • Test and debug your application

Building CAD Programs Using Visual C++

##CPP##

The LTSample Visual C++ example project is an MFC application that shows how to use many of the functions available in the TurboCAD SDK to build a highly interactive application.

To create a new project for making a standalone TurboCAD application in Visual C++, make sure to follow these steps:

  • Choose an appropriate project type, based on your desired development framework, either "Win32 Application", "MFC AppWizard (exe)", or "ATL/WTL AppWizard".
  • Add the path for the TurboCAD SDK's header files to your project's C++ preprocessor settings
  • Other build and project settings?
  • Add your code
  • Compile your application
  • Test and debug your application


Deploying Custom TurboCAD Applications

When you have built and tested your application, make sure that your installation includes all necessary DLL's, placed in the correct directories, and that your installation process registers the TurboCAD object library correctly. Also make sure that you install the any required runtime DLL's. For Visual Basic 6.0 projects you must make sure to include vbrun32.dll. For MFC applications, you will need to include mfc42.dll. Other runtime DLL's might also be required.

Finally, if you plan on distributing your application to other users, make sure that you have obtained a developer license from IMSI. A sample agreement form can be found here. If you have questions about the terms and limitations of your SDK license, please contact IMSI.


Building TurboCAD ActiveX Controls

Using the TurboCAD SDK, you can build ActiveX controls. These are DLL's that enable you to put TurboCAD functionality on a web page, so that you can load, edit, save, and view CAD data over the web.

NOTE If you are interested in selling or otherwise distributing ActiveX controls built with the SDK, including making your server-hosted controls available for download to web clients, you must obtain a developer license from IMSI. A sample agreement form can be found here. If you have questions about the terms and limitations of your SDK license, please contact IMSI.

Building ActiveX Controls Using Visual Basic

The TCViewX Visual Basic example project shows how to attach a drawing's view to the control window, and use the View object's Refresh method to paint the control.

Building ActiveX Controls Using Visual C++

##CPP##

The OCXDemo Visual C++ example project is an MFC-based ActiveX control that you can use as a basis for building your own controls.

To create a new project for making a standalone TurboCAD application in Visual C++, make sure to follow these steps:

  • Choose an approprate project type, based on your desired development framework, either "Win32 Dynamic-Link Library", "MFC ActiveX Control Wizard", or "ATL COM AppWizard".
  • Add the path for the TurboCAD SDK's header files to your project's C++ preprocessor settings
  • Make sure to include a version resource
  • Other build and project settings?
  • Add your code
  • Compile your application
  • Test and debug your application


Deploying TurboCAD ActiveX Controls

Once built and tested, you must follow all the recommendations and requirements described in the Deploying Standalone Applications section. Since TurboCAD ActiveX controls hosted on a remote web server require that multiple DLL's be downloaded and registered on the client machine, they are usually packaged in a CAB file that contains deployment and registration information. In addition, you may want to purchase a security certificate that will help users to confirm or reject the installation of your ActiveX control.

In particular, any TurboCAD ActiveX control you build that will be placed on a web server accessible to multiple users must be covered by a developer license obtained from IMSI. A sample agreement form can be found here. If you have questions about the terms and limitations of your SDK license, please contact IMSI.


Extending TurboCAD with Custom Extensions

SDK extensions are Automation servers that extend the functionality of TurboCAD. There are three types of extensions that are currently supported: custom Regen objects, file filters, tools, ties and palettes.

Custom Regen objects allow third parties to develop constraints and other custom logic for graphic elements of a drawing.

File filters allow new file types to be edited by TurboCAD, and new export formats to be created from any drawing that TurboCAD can edit. Both custom Regen object and file filter extensions will work with the in-process server version of the SDK, so that you can build a custom application that uses your extensions, as well as extend the capabilities of TurboCAD as a standalone application or local server.

Tool extensions allow you to install new commands into TurboCAD's user interface, and so are not useful for extending the in-process server.

Tie extensions allow you to create and maintain inter-object dependencies between different types of graphics in a drawing. For example, associative dimensions (dimensions that stick to the object or objects they dimension) are implemented as a custom tie.

Palette extensions are resizable windows that you can dock in TurboCAD's palette area, and with which you can build interfaces that work in tandem with TurboCAD.

Any development environment that supports building COM server DLL's can build a TurboCAD extension. This includes Visual Basic and Visual C++. Each extension server DLL must expose a coclass with a default IDispatch interface that conforms to a particular set of methods and properties for the appropriate extension type. In addition, the DLL must contain a single COM type library that describes the coclass (creatable object type) and its IDispatch interface. Tie extensions are unique among extension types in that they must expose a VTBL (early binding) interface, called ITurboCADSmartTieServer as their default interface.

On startup, the TurboCAD engine tries all the DLL's in specific named subdirectories, looking for DLL's with appropriate type libraries, and registers these DLL's by creating objects in the collections of the Application object. For custom Regen objects, a RegenMethod object is added to the Application's RegenMethods collection. For file filters, a Filter object is added to the Application's Filters collection. For tools, a Tool object is added to the Application's Tools collection. Tie extensions cause a TieMethod object to be added to the Application's TieMethods collection. Palettes do not expose an object in the Application's collections, since a palette is always identified by its window handle.


Creating Custom Regen Objects

Custom Regen objects are the technology that TurboCAD uses to allow the creation and maintenance of graphic entities that contain rules to constrain or modify their states based on geometry and other attributes. By writing your own Custom Regen objects, you can create an infinite variety of graphics which exhibit specific behaviors. The SDK provides several sample Custom Regen object extensions written in a variety of languages for you to begin with.

Custom Regen objects are Automation servers, where the TurboCAD engine is the client. A custom Regen object server creates one or more automation objects, through the standard COM creation system. Each automation object must support a standard suite of methods and properties, specified by the IRegenServer interface, necessary to support the custom Regen objects that they control.

Custom Regen object extensions are loaded when the server first starts up. To be successfully loaded, a custom Regen object extension DLL must be located in the Regens subdirectory of the TurboCAD engine's Program directory. Each module (DLL) in this directory is queried for a COM type library that tells TurboCAD what extensions are served by the module. Then the module's automation object or objects are created. For each installed Regen object server (whether built-in or a custom Regen object created by a programmer), TurboCAD creates a corresponding RegenMethod object that is added to the Application object's RegenMethods collection.

On initialization, the custom Regen object server tells TurboCAD the number and types of properties that its graphic supports. Later, TurboCAD will call on the Custom Regen object server to store and retrieve these properties, and more importantly, will ask the custom Regen object server to "regen" its graphics when they have been modified by users. This regen process allows the Custom Regen object server to maintain its graphics using its own logic.

The custom Regen object must implement an IDispatch or dual interface that includes all the methods and properties of the IRegenServer interface:

IRegenServer Properties
Property | Description
ClassID | A String returning the unique identifier for this server.
Description | A String giving a short, human readable description for the server.
IRegenServer Methods
Method | Description
Initialize | Called first, at startup time. This method lets your server create and initialize any necessary internal data structures.
GetPropertyInfo | Called at startup time. Tells the TurboCAD engine the names, types, local IDs, and default values of the extra properties that your custom Regen objects will support.
GetEnumNames | Called at startup time. Tells the TurboCAD engine the name-to-value mapping for any enumeration value type properties.
GetPageInfo | Called at startup time. Tells the TurboCAD engine the captions of the property pages that your server will provide to support property editing. Also tells the TurboCAD engine what stock property pages (such as "Pen", "Brush", "Text") your custom Regen objects will want the TurboCAD engine to expose.
PropertyPages | Called to initialize and start a single property page.
PageControls | Called during property page editing to synchronize the values held on the property page with the object or objects being edited. Depending on the SaveProperties parameter, the object is updated with the properties on the page, or the page controls are updated based on the object's property values.
PageDone | Called after property page editing has been completed and the page has been closed, so that your server can release any temporary memory.
OnNewGraphic | Called when TurboCAD is creating a new Graphic object. Your OnNewGraphic method will fill in the vertices, child graphics, and set up any initial property values, then return TRUE to indicate the successful creation. This method is also called during copying of Graphics, if there is any special referencing or manipulation to be carried out.
OnCopyGraphic | Called when TurboCAD is copying one of your Graphic objects. Usually there is no special processing your server needs to do, except to return TRUE to permit the copying to proceed.
OnGeometryChanging | Called before the TurboCAD engine will modify an object's geometry. Return TRUE to permit the modification to proceed.
OnGeometryChanged | Called after the geometry modification has been performed.
OnPropertyChanging | Called before the TurboCAD engine will modify a property of an object. Return TRUE to permit the modification to proceed.
OnPropertyChanged | Called after the property modification has been performed.
OnPropertyGet | Called when TurboCAD needs to read one of a Graphic's properties, in case your server needs to perform any calculations.
Regen | Called before TurboCAD needs to display or get information about one of your Graphic objects. This is the method that usually adds or updates child cosmetic Graphic objects, based on the property values of the parent object.
Draw | Called when TurboCAD needs to draw one of your Graphic objects, in case there are special features that you need to draw. In most cases, your Graphic's cosmetic child graphics will have been set up correctly so that they will display your Graphic's appearance appropriately.
GetWizardInfo | Not used.
Wizard | Not used.
GetDistance | Not used.
CalcBoundingBox | Not used.


Coding a Custom Regen Object

In Visual Basic, the Rounded Rectangle and Coordinate Text are explained by tutorials that provide step-by-step instructions for creating them. We will refer to these examples as we explore some key concepts in building your own custom regen objects.


Exposing Custom Regen Object Properties

Usually you're the Graphic objects that your server will manage will expose one or more custom properties. Your server can define any number and type of these properties that you wish. In the simple case of our RRect example, you let the built-in TurboCAD Graphic object define most of the standard properties, such as "Line Type", "Pen Color", etc. You supply just one property "Roundness", that will define the radius of the rounded corners of the rectangle. In this example, you specify Roundness as a percentage (a double value from 0 to 100), to avoid any dependency on the height or width of the rectangle. The default value for Roundness will be 50.

Defining Properties and Property Pages

You tell TurboCAD about this property in the GetPropertyInfo method. First you define a constant, NUM_PROPERTIES, to indicate the number (1) of properties you are going to add, and a local integer ID value, idRoundness, that will be used when TurboCAD is communicating with our server about the Roundness property. Then you re-dimension and fill in the information about the property:

Const NUM_PROPERTIES = 1
Const idRoundness = 1
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
    Names(0) = "Roundness"
    Types(0) = typeDouble
    IDs(0) = idRoundness
    Defaults(0) = 50#
    GetPropertyInfo = NUM_PROPERTIES
End Function

Since you also need to support a user interface for editing this property, you build a user form with a text box on it to display the value of the property, and then tell TurboCAD the caption of this form in our GetPageInfo method:

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32
Const NUM_PAGES = 1
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmRRect
    Names(0) = frmRRect.Caption
    Unload frmRRect

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Here, GetPageInfo also is telling TurboCAD that you want to expose the standard Brush, Pen, and Automation property pages, by returning a flag in the StockPages parameter.

Displaying and Synchronizing Property Pages

Now that TurboCAD knows about our property and the page that it is edited on, you need to actually implement the editing and synchronization code. When the user right-clicks on one of our RRect Graphics and chooses "Edit Properties", she will see a property dialog containing the stock Pen, Brush pages, and the Caption "Round Rectangle" that you supplied in the GetPageInfo method. When she clicks on this tab, our PropertyPages method will be called. This is the time for us to display the form:

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmRRect
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

When the form first comes up, or when the user has clicked on the Apply button, or tabbed to another page on the form, our PageControls method will be called. Depending on the value of the SaveProperties parameter, you either update our Graphic's properties or update the display on the form:

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed

        Dim Roundness#
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmRRect
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next

                'When the property page is closed, transfer the numeric
                'roundness value from the TextBox to the Graphic
                'Get the value as a double-precision number
                Roundness# = CDbl(.txtRoundness.Text)
                'Make sure it's between 0 and 100
                If Roundness# < 0# Then Roundness# = 0#
                If Roundness# > 100# Then Roundness# = 100#
                'Set the roundness property value in the Graphic
                Graphic.Properties("Roundness") = Roundness#
            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmRRect
            With frmRRect
                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                'roundness value from the Graphic to the TextBox
                'Get the roundness property value from the Graphic
                Roundness# = Graphic.Properties("Roundness")
                'Set the TextBox control's text
                .txtRoundness.Text = Roundness#
NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Finally, when TurboCAD is completely finished using our property page (usually when the user dismisses the entire property dialog), our PageDone method is called. Here you can safely unload our form:

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmRRect
End Function

Responding to Property Change and Get Requests

For the other property-related methods, OnPropertyChanging, OnPropertyChanged, and OnPropertyGet, you don't need to do anything special, so you use the "default" behavior:

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

That's all that you need to do to support custom properties! Of course, more sophisticated objects could use these notifications to refuse the change of particular properties under certain conditions, or to return a property value based on calculations, rather than stored values.


Setting up Custom Graphics

Two methods, OnNewGraphic and OnCopyGraphic, are responsible for initializing the contents of your custom Graphic objects. In the RRect case, we build a Graphic that will contain four Vertex objects to define the geometry: the first two to define the corners of the rectangle, the third to define the calculated roundness point (a "handle" that we will calculate based on the location of the rectangle and the Roundness property), and the fourth to define a user-movable handle that can be manipulated using the TurboCAD node-edit selector to change the roundness. To create a "default" object we define the rectangle to be bounded by the points (-1, -0.5, 0) and (1, 0.5, 0), and place the calculated and movable roundness handles at the same location, (0.75, 0.6, 0), as shown below:

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If

    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "lower left" corner
    grfThis.Vertices.Add -1#, -0.5, 0#, False, True, False, False, False
    'Second Vertex is "upper right" corner
    grfThis.Vertices.Add 1#, 0.5, 0#, False, True, False, False, False
    'Third Vertex is rounding handle (calculated)
    Dim R#, Roundness#, Offset#
    Roundness# = grfThis.Properties("Roundness")
    R# = 0.5 * Roundness# / 100#
    Offset# = 0.1 * R#
    grfThis.Vertices.Add 1# - R#, 0.5 + Offset#, 0#, False, False, False, False, False
    'Fourth Vertex is rounding handle (editable)
    grfThis.Vertices.Add 1# - R#, 0.5 + Offset#, 0#, False, True, False, True, False
    grfThis.Properties("LimitVertices") = 4
    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

One minor detail to notice is the LimitVertices property. This built-in property of all TurboCAD graphics tells the engine that this Graphic should never have more than four vertices.

The OnCopyGraphic method is just used to signal that TurboCAD can always make copies of our RRect graphics:

Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

You can also use OnCopyGraphic to do any special setup of the newly copied Graphic object or its geometry or properties that depends on information stored in the original Graphic.

Using Vertex Flag Properties

In addition to setting the Cosmetic flag on the Graphic objects that the Regen object server controls, the Regen object server may also manipulate flags on the Graphic's contained Vertex objects, in order to signal specific behavior to the TurboCAD engine. Each flag represents a particular aspect of the vertex. In the case of the four vertices specified in the OnNewGraphic method, note that all are specified with PenDown:=False, Snappable:=False, and Linkable:=False. This is because we don't want these vertices drawing line segments, used for snaps or for links (i.e. dimensions). Those features will be given to our Graphic by the cosmetic graphic children when our Regen method is called.

Note that the vertices that we want our user to see in the selection (the lower left, upper right, and movable handle) have their Selectable flag set to True, and that the movable handle also has the Editable flag set to True, so that it can be picked in node-edit mode.


Creating and Using Cosmetic Graphics During Regen

The key principle that most Regen objects take advantage of is the cosmetic Graphic. This is a graphic that the Regen object server adds to the drawing with the Cosmetic property set to True. When the user modifies a property of the Graphic, the Regen object server updates the cosmetic Graphic object appropriately. The Cosmetic flag tells the TurboCAD engine that the geometry of the Graphic can be reconstructed at any time from Graphic's other properties, thanks to the logic contained in the Regen object server.

Normally the time to create or update these cosmetic Graphics is in your server's Regen method implementation. TurboCAD uses a "lazy" system, calling your server's Regen method only when necessary (such as when making one of your server's objects visible).

In the RRect object server, the Regen method is responsible for two things:

  • Detecting whether the roundness handle was moved by the user, and thus whether the Roundness property needs to be updated
  • Creating the cosmetic child Graphic objects that draw the rounded rectangle, based on the location of the rectangle definition corners and the Roundness factor.

The Regen method does not have to concern itself with code to scale, rotate or transform the vertices in the parent, non-cosmetic, Graphic. Nor does it need to explicitly destroy the existing cosmetic children-this is all handled by the TurboCAD engine itself.

Here is the code for the RRect object server's Regen method:

'Called when we need to update our object
Public Function Regen(ByVal grfThis As Object)
        'Setup error handler
        On Error GoTo Failed

        'grfThis.Application.PushVertexDefaults Editable:=True, Selectable:=True

        'Set up lock (prevent recursion)
        Dim LockCount&
        LockCount& = grfThis.RegenLock

        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
            grfThis.Graphics.Clear gfCosmetic

            Dim boolHandleMoved As Boolean

            'Calculate height, width and radius of corners
            Dim W#, H#, R#, Roundness#
            With grfThis.Vertices
                If (Abs(.Item(2).X - .Item(3).X) < 0.000001 And _
                    Abs(.Item(2).Y - .Item(3).Y) < 0.000001) Then
                    boolHandleMoved = False
                Else
                    boolHandleMoved = True
                End If
                W# = Abs(.Item(1).X - .Item(0).X)
                H# = Abs(.Item(1).Y - .Item(0).Y)
            End With
            'Radius of arcs is based on minimum of width and height
            If W# < H# Then
                R# = W# / 2#
            Else
                R# = H# / 2#
            End If
            'Adjust radius for roundness
            If boolHandleMoved Then
                Roundness# = Abs(grfThis.Vertices(2).X - grfThis.Vertices(3).X)
                Roundness# = Roundness# * 100# / R#
                If Roundness# > 100# Then Roundness# = 100#
                'Relocate handle

                'Update property to reflect handle location
                grfThis.Properties("Roundness") = Roundness#
            Else
                Roundness# = grfThis.Properties("Roundness")
                If Roundness# < 0# Then Roundness# = 0#
                If Roundness# > 100# Then Roundness# = 100#
            End If
            R# = R# * Roundness# / 100#

            'Add child Graphics
            Dim grfChild As Object
            Dim X0#, Y0#, X1#, Y1#, T#
            With grfThis.Vertices
                X0# = .Item(0).X
                Y0# = .Item(0).Y
                X1# = .Item(1).X
                Y1# = .Item(1).Y
                'Make sure X0 < X1
                If (X0# > X1#) Then
                    T# = X0#
                    X0# = X1#
                    X1# = T#
                End If
                'Make sure Y0 < Y1
                If (Y0# > Y1#) Then
                    T# = Y0#
                    Y0# = Y1#
                    Y1# = T#
                End If
            End With
            If R# = 0# Then
                'No rounded corners
                'All children are cosmetic
                Set grfChild = grfThis.Graphics.Add(gkGraphic)
                grfChild.Cosmetic = True
                'Now add vertices to the child
                With grfChild.Vertices
                    .Add X0#, Y0#, 0
                    .Add X0#, Y1#, 0, True
                    .Add X1#, Y1#, 0, True
                    .Add X1#, Y0#, 0, True
                    'Close the rectangle
                    .AddClose PenDown:=True 'PenDown
                End With
            Else
                'Rounded corners
                'We'll make 4 line children and 4 arc children
                'First line
                'All children are cosmetic
                Set grfChild = grfThis.Graphics.Add(gkGraphic)
                grfChild.Cosmetic = True
                'Now add vertices to the child
                With grfChild.Vertices
                    .Add X0# + R#, Y0#, 0
                    .Add X1# - R#, Y0#, 0, True
                End With
                'First arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet X1# - R#, Y0# + R#, 0#, R#, , 1.5 * Pi#, 0#
                'Second line
                Set grfChild = grfThis.Graphics.Add(gkGraphic)
                grfChild.Cosmetic = True
                With grfChild.Vertices
                    .Add X1#, Y0# + R#, 0
                    .Add X1#, Y1# - R#, 0, True
                End With
                'Second arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet X1# - R#, Y1# - R#, 0#, R#, , 0#, 0.5 * Pi#
                'Third line
                Set grfChild = grfThis.Graphics.Add(gkGraphic)
                grfChild.Cosmetic = True
                With grfChild.Vertices
                    .Add X1# - R#, Y1#, 0
                    .Add X0# + R#, Y1#, 0, True
                End With
                'Third arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet X0# + R#, Y1# - R#, 0#, R#, , 0.5 * Pi#, Pi#
                'Fourth line
                Set grfChild = grfThis.Graphics.Add(gkGraphic)
                grfChild.Cosmetic = True
                With grfChild.Vertices
                    .Add X0#, Y1# - R#, 0
                    .Add X0#, Y0# + R#, 0, True
                End With
                'Fourth arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet X0# + R#, Y0# + R#, 0#, R#, , Pi#, 1.5 * Pi#
            End If

            'Add visible child Graphics
        End If

        grfThis.RegenUnlock
        'grfThis.Application.PopVertexDefaults
        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:
        'grfThis.Application.PopVertexDefaults

        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If
End Function

In this example, the code determines whether it needs to create a single rectangle polygon child Graphic (in the case where the Roundness factor is zero), or a group of four lines and four arcs. In either case, the child Graphics are created in the parent Graphic's Graphics collection, Vertices added to them, and the Cosmetic flag is set to True for each of the children.

The other important thing to note is that all of the operations in the Regen method are bracketed by a beginning call to Graphic.RegenLock and an ending call to Graphic.RegenUnlock. Each call to a the RegenLock method increments a counter in the Graphic object, and the subsequent RegenUnlock decrements this counter. By examining the return value of RegenLock, and only touching the contents of the Graphic when the counter is zero, you can prevent any manipulation of the Graphic's properties and geometry from calling your Regen method over and over again. Failure to use RegenLock and RegenUnlock in this way will most likely result in a crash, due to a recursion of infinite depth.


Installing and Debugging Custom Regen Object Servers

To install the custom Regen object server, you just place the compiled server DLL in the Regens subdirectory of the TurboCAD engine's Program directory. When TurboCAD starts up, it tries to load a type library resource in the DLL. If it finds one, it opens the type library, discovers any coclasses, and attempts to create server object instances by calling CoCreateInstance. Then methods and properties on the server object instance are called to obtain the information necessary for the engine to create a RegenMethod object: the Initialize method is called, so that the Regen object server can perform any startup tasks, the ClassID and Description properties are read.

To debug a Regen object server that was written in Visual Basic, you can place the VBP (Visual Basic Project) file in the Regens subdirectory, and delete the compiled DLL. TurboCAD supports VB debugging by also looking for files with a .VBP extension and trying to load them.

##CPP##

To debug Regen object servers in C++, you can place breakpoints in your source code, and specify TurboCAD as the debugging application. You should see the object creation code called first, and the other initialization steps follow later. If your Regen object server is never called, check to make sure that the type library resource has been properly added to your DLL.


Creating Custom Filters

File filters are extension objects that TurboCAD uses to read graphic information from disk into the current drawing, or to save the current drawing to disk. The SDK provides several sample file filter extensions written in a variety of languages for you to learn from.

File filters, like Custom Regen objects, are Automation servers, where the TurboCAD engine is the client. A file filter server creates one or more automation objects, through the standard COM creation system. Each automation object must support a standard suite of methods and properties, necessary to support the filters (typically one for each file extension) that they control.

File filter extensions are loaded when the server first starts up. To be successfully loaded, a file filter extension DLL must be located in the Filters subdirectory of the TurboCAD engine's Program directory. Each module (DLL) in this directory is queried for a type library that tells TurboCAD what extensions are served by the module. Then the module's automation object or objects are created. For each installed filter server (whether built-in or a custom filter object created by a programmer), TurboCAD creates a corresponding Filter object that is added to the Application object's Filters collection.

On initialization, the filter server gives TurboCAD an information string that describes the file extension, the string that will appear in the file open and file save dialogs, and some flags that control the matching algorithm that TurboCAD uses when searching for a filter that matches a particular file type. Then, when the user chooses to open or save a file, TurboCAD will call on the file filter server to process the input or output of the current drawing.

The filter server object must implement an IDispatch or dual interface that includes all the methods and properties of the IFilterServer interface:

Check methods against filterserver.idl file

IFilterServer Properties
Property | Description
Info | A String giving a list of fields that give a human readable description for the file type handled by the server, the file name extensions handled, and a priority number for the case where multiple filters exist for the same extension.
LastError | A String that represents the error or errors encountered during the last Check, Read or Write operation.
IFilterServer Methods
Method | Description
Initialize | Called first, at startup time. This method lets your server create and initialize any necessary internal data structures.
ReadSetup | Called when the user clicks on the Setup… button when opening a file handled by our filter. This method allows you to display a dialog for the user to make any preferences required.
CheckFlat | Called when the user selects a file to open. This method allows you to read a few bytes of the file to determine whether it is of the right type.
ReadFlat | Called when the user selects a file to open. This method is responsible for creating and the Graphic objects to the new drawing.
PreviewFlat | Called when the user selects a file to open. This method allows you to create a StdPicture object that will be displayed in the Open File dialog.
WriteSetup | Called when the user clicks on the Setup… button when saving a file handled by our filter. This method allows you to display a dialog for the user to make any preferences required.
WriteFlat | Called when the user selects a file to save. This method is responsible for creating the file based on the Graphic objects contained in the current TurboCAD drawing.


Coding a Filter

Written in Visual Basic, the FP3 filter reads Floor Plan Plus 3D files (another IMSI drawing format). JPEG is a Visual C++ output filter that writes the current drawing out as a JPEG file. For detailed information, consult the comments in the source files.


Installing and Debugging Filters

To install and debug your custom filter, follow the guidelines given in the section "Installing and Debugging Custom Regen Object Servers", placing the filter DLL in the Filters subdirectory of the TurboCAD engine's Program directory.


Creating Custom Tools

Tools are extension objects that TurboCAD incorporates into its user interface, as persistent commands that can be activated through menu items and toolbar buttons. Tools are maintained in TurboCAD on a stack, with the "active" tool at the top of the stack. The SDK provides a sample tool extension project, written in Visual Basic, to give you an idea of how to implement tools.

Tool servers are Automation servers, where the TurboCAD engine is the client. A tool server creates one or more automation objects, through the standard COM creation system. Each automation object must support a standard suite of methods and properties, necessary to support the tool architecture.

Tool extensions are loaded when TurboCAD first starts up. To be successfully loaded, a tool extension DLL must be located in the Draggers subdirectory of the TurboCAD engine's Program directory. Each module (DLL) in this directory is queried for a type library that tells TurboCAD what extensions are served by the module. Then the module's automation object or objects are created. For each installed tool object server, TurboCAD creates a corresponding Tool object that is added to the Application object's Tools collection.

On initialization, the tool server gives TurboCAD information strings that describe the user interface properties of the tool: menu item string, status bar prompts, etc. When the user pulls down a menu the tool object's UpdateToolStatus is invoked to set the enabled and checked state of the menu item. When the user selects the tool on a menu or toolbar, the tool object's Run method is invoked to perform the tool's actions.

The tool server object must implement an IDispatch or dual interface that includes all the methods and properties of the IToolServer interface:

IToolServer Properties
Property | Description
Description | A String giving a short, human readable description for the server.
IToolServer Methods
Method | Description
Initialize | Called at startup. Your method can create any necessary internal data structures.
GetToolInfo | Called at startup. Tells TurboCAD the user interface information necessary to integrate your tool into TurboCAD's menus and toolbars, such as the menu and submenu names, toolbar names, "tool tip" strings, and whether the tool commands are initially enabled or require update messages.
GetPicture | Called at startup. Returns a strip of toolbar button images of requested size and color depth corresponding to individual tool commands, as a StdPicture object.
GetLMPicture | Called at startup. Returns a strip of button images corresponding to the local menu items that appear in the Inspector Bar, as a StdPicture object.
UpdateToolStatus | Called by the TurboCAD engine to query the server for the enabled and checked state of the tool.
Run | Called by the TurboCAD engine to execute a tool command.
DoLMCommand | Called by the TurboCAD engine after the user has selected an item in the tool's local menu (right-click context menu).
CopyBitmap | Not used.


Coding a Tool

Written in Visual Basic, the Inet tool checks to see if the current selection has a "URL" custom property. If so the tool opens a Web browser page to the selection's URL. If no "URL" property exists on the current selection, then the browser is opened on http://www.imsisoft.com.

##CPP##

The InsertFile tool is another example that shows how to code a tool. When run, this tool inserts symbols into the current drawing. InsertFile also shows how to integrate a custom Regen object server and tool.


Integrating a Tool into TurboCAD's User Interface

The GetToolInfo method implemented by your tool server is responsible for telling TurboCAD where to insert your tool server's individual commands in the TurboCAD menu structure, and provides other information about the tool commands. GetToolInfo dimensions and returns six arrays that specify the characteristics of all the tool commands supported by your server.

The CommandNames array is a one- or two-dimensional array. If your server sets this up as a one-dimensional array, each item in the array specifies the menu "path" string for the command. The submenu names are separated by the pipe character, '|'. If the array is dimensioned as a two-dimensional array, the second index in the array contains the following strings:

CommandNames 2nd Index
Index | Description
0 | Menu path for this command as described above.
1 | Style name for default Graphic created by this command.
2 | Graphic type for Graphic created by this command.
3 | RegenMethod name for Graphic created by this command.

The MenuCaptions array is a one- or two-dimensional array. If your server sets this up as a one-dimensional array, each item in the array specifies the menu item string and ALT-key shortcut, using the Win32 menu resource convention of preceding the shortcut key letter by the ampersand character, '&'.

If the array is dimensioned as a two-dimensional array, the second index in the array contains the following strings:

MenuCaptions 2nd Index
Index | Description
0 | Menu item for this command as described above.
1 | Toolbar name for toolbar containing this command.

The StatusPrompts array is a one- or two-dimensional array. If your server sets this up as a one-dimensional array, each item in the array specifies the string that will appear in TurboCAD's status bar when the command is executing.

If the array is dimensioned as a two-dimensional array, the second index in the array contains the following strings:

MenuCaptions 2nd Index
Index | Description
0 | Status bar prompt for this command as described above.
1 | Decimal value of the help context id for this command in the TurboCAD main help file, as a string.

The ToolTips array is a one-dimensional array, where each item in the array contains the text displayed in the pop-up "tool tip" when the user hovers the mouse over the command's toolbar icon.

The Enabled array is a one-dimensional array, where each item in the array contains a True or False value that indicates whether the command is initially available to the user.

The WantsUpdates array is a one-dimensional array, where each item in the array contains a True or False value that indicates whether the command's enabled or checked status may change depending on the selection state or other program state changes. By setting this value to True, your server will receive update messages before the menus and toolbars are displayed.

For example, here is the GetToolInfo method for the Inet sample (a server that only implements one command):

Const NUM_TOOLS = 1
Public Function GetToolInfo(CommandNames As Variant, MenuCaptions As Variant, StatusPrompts As Variant, _
    ToolTips As Variant, Enabled As Variant, WantsUpdates As Variant) As Long
    ReDim CommandNames(NUM_TOOLS)
    ReDim MenuCaptions(NUM_TOOLS, 2)
    ReDim StatusPrompts(NUM_TOOLS)
    ReDim ToolTips(NUM_TOOLS)
    ReDim Enabled(NUM_TOOLS)
    ReDim WantsUpdates(NUM_TOOLS)
    CommandNames(0) = "SDK|Hyperlink"
    MenuCaptions(0, 0) = "&Hyperlink"
    MenuCaptions(0, 1) = "SDK" ' toolbar name
    StatusPrompts(0) = "Launch a browser on the World Wide Web"
    ToolTips(0) = "Hyperlink"
    Enabled(0) = True
    WantsUpdates(0) = False
    GetToolInfo = NUM_TOOLS
End Function

Providing Toolbar Button Images

In addition to return string information that tells TurboCAD where to insert menu items for tool commands in its menus, your server can also provide a strip of toolbar button images, which TurboCAD will use to insert buttons into specified toolbars. The GetPicture method is responsible for return image strips in two sizes. Each button image should be 16 pixels wide by 15 pixels high for small buttons, and 24 pixels wide by 23 pixels high for large buttons, and should use a 256-color (8-bit indexed color) bitmap.

You make a horizontal strip of these button images, with one image for each command listed in the GetToolInfo method, and then return the image strip as a StdPicture object. In Visual Basic, you can either load the bitmap image strips from .BMP files, or from bitmap resources contained in your server's DLL.

The TurboCAD engine will build enabled and disabled button graphics based on the bitmap images you return in the GetPicture method. TurboCAD uses the magenta RGB color (R=255, G=0, B=255) to indicate the transparent background that the button image will be extracted from, so make sure that your image strip uses magenta for its background color, and that no part of the image that you want to be part of the button graphic contains magenta pixels, or else this part will appear transparent when shown on the TurboCAD toolbars.

Updating Tool Command Status

If you want to present more sophisticated feedback to the user, you can control the enabled and checked state of your tool commands. In your GetToolInfo method, make sure to set the value of the WantsUpdates array item to True. Then implement the UpdateToolStatus, setting the values Enabled and Checked to True or False depending on the state of the program. For example you might check that the current drawing's Selection object contains specific graphic types before setting the Enabled value of your tool command to True. If you have multiple, exclusive commands, you might check to determine which command is active and set the Checked value accordingly, as is done in the Bool2D sample:

Public Function UpdateToolStatus(ByVal Tool As Object, Enabled As Boolean, Checked As Boolean) As Boolean
    Enabled = True 'Could do a test here to determine whether to disable the button/menu item
    If iConnectId = -1 Then
        Checked = False  'Could do a test here to determine whether to check the button/menu item
    Else
        If Tool.Index = iActTool Then
            Checked = True
        Else
            Checked = False
        End If
    End If
    UpdateToolStatus = True
End Function


Performing a Tool Command's Function

The Run method of your tool server is called when the user clicks on your tool command's toolbar button, or chooses the corresponding menu item. Run, like many of the methods in your tool server, passes you a reference to the currently active Tool object. You can perform any checking or manipulation of data that you wish in this method. The Inet sample launches a browser based on the contents of the selection when the Run method is called, using the Tool object that is passed to the method to find the selection:

Public Function Run(ByVal Tool As Object) As Boolean
    Dim objApp As Object
    Dim objSel As Object
    Dim objGraphic As Object
    Dim strURL As String
    On Error Resume Next

    'Look for first URL property in the selection
    Set objApp = Tool.Application
    Set objSel = objApp.Selection
    For Each objGraphic In objSel
        strURL = ""
        strURL = objGraphic.Properties("URL")
        If strURL <> "" Then
            StartBrowser strURL
            Run = True
            Exit Function
        End If
    Next objGraphic

    'No selection or no URLs: just start browser at a convenient home page
    StartBrowser "http://www.imsisoft.com/"
    Run = True
End Function

What is RunTool?


Implementing Multi-State Tool Commands

If your tool command's functionality requires more than a simple mouse click or menu shortcut key to execute, you will need to intercept TurboCAD events and implement a "state machine" that keeps track of the current state of the command and the events caused by user action. Such multi-state commands also usually need to change the status bar string and can add items to local menus (right-click context menus) that can change depending on the state of the command. This section will highlight some of the steps involved in implementing multi-state commands. For more details, see the Bool2D example project.

Tracking TurboCAD Events

As described in the section "Handling TurboCAD Events", your tool server can implement a class module that will receive event notifications, so that you can act on user mouse, keyboard and other actions appropriately. Your tool server should connect to the TurboCAD event system as explained, and maintain the event connection as long as necessary.

If you are writing a multi-state command, you probably want to inform the user what to do, based on the current state of your command. The TurboCAD Application object exposes an interface named IToolEvents that gives you more control over the status bar. The IToolEvents interface you obtain contains two methods that multi-state commands can use to update the user interface as the user makes transitions betweens tool command states:

Describe methods

IToolEvents Methods
Method | Description
ToolChangePrompt |
ToolChangeCommands |

To use the IToolEvents interface, you can "coerce" the interface from the Application object. In the Bool2D example, a global variable is used to hold the IToolEvents interface. It is set up in the Initialize method, and torn down in the class module's Terminate method:

Private theToolEvents As IToolEvents
Public Function Initialize(ByVal Tool As Object) As Boolean
On Error GoTo ErrorHandler
    Set objApp = Tool.Application
    Set theToolEvents = objApp
    Initialize = True
ErrorHandler:
End Function

##CPP##

To obtain the IToolEvents interface using C++, you use the standard COM QueryInterface method, or one of its smart pointer equivalents:

IApplication* pApp = NULL;
IToolEvents* pToolEvents = NULL;
HRESULT hr;
hr = pTool->get_Application(&pApp);
if (SUCCEEDED(hr))
    hr = pApp->QueryInterface(IID_IToolEvents, (void**)&pToolEvents);

Updating the Status Bar Prompt

Once you have obtained a reference to the Application object's IToolEvents interface, you can update the text in the status bar dynamically by calling the IToolEvents.ToolChangePrompt method, passing the string that you want to display:

theToolEvents.ToolChangePrompt Me, "Select First graphic", False

Adding Local Menus for a Tool's Commands

Multi-state commands also usually provide right-clickable context menus, or "local menus", that give the user finer control over the actions he might take during the execution of a tool command. The IToolEvents.ToolChangeCommands method gives you the ability to add and remove your own custom menu items at any time. You pass four arrays to ToolChangeCommands, representing the menu item captions, the corresponding status bar prompts, and the current enabled and checked states of the menu items. The Bool2D example contains a private function that performs this updating:

Private Function AddLM(bAdd) As Boolean
Dim Captions(0 To 0) As String
Dim Prompts(0 To 0, 0 To 1) As String
Dim Enabled(0 To 0) As Boolean
Dim Checked(0 To 0) As Boolean

 Dim varCaptions As Variant
 Dim varPrompts As Variant
 Dim varEnabled As Variant
 Dim varChecked As Variant
    If (bAdd) Then
        Captions(0) = LoadResString(116) '"Finish Boolean2D"
        Prompts(0, 0) = LoadResString(116) '"Finish Boolean2D"
        If iActTool = 0 Then
            Prompts(0, 1) = "95140"
        End If
        If iActTool = 1 Then
            Prompts(0, 1) = "95141"
        End If
        If iActTool = 2 Then
            Prompts(0, 1) = "95142"
        End If
        Enabled(0) = True
        Checked(0) = False

        varCaptions = Captions
        varPrompts = Prompts
        varEnabled = Enabled
        varChecked = Checked
        theToolEvents.ToolChangeCommands Me, 1, varCaptions, varPrompts, varEnabled, varChecked, True
    Else
       theToolEvents.ToolChangeCommands Me, 0, , , , , False
    End If
End Function

You must make sure to remove all the local menu command items when your tool has finished executing, by passing zero as the second parameter to ToolChangeCommands, as shown in the code above (when bAdd is False).

Providing Local Menu Buttons for the Inspector Bar

If you are building a local menu using the ToolChangeCommands method, you probably also want to supply custom menu buttons for TurboCAD's Inspector Bar. To accomplish this, you implement the GetLMPicture method in your class module, and pass an image strip (small button size, 16 pixels wide by 15 pixels high) which contains one button image for each item in the local menu. The other requirements and conventions for TurboCAD toolbar button images, described in the section "Providing Toolbar Button Images" also apply to Inspector Bar button images.


Installing and Debugging Tools

To install and debug your custom tool, follow the guidelines given in the section "Installing and Debugging Custom Regen Object Servers", placing the tool DLL in the Tools subdirectory of the TurboCAD engine's Program directory.


Creating Custom Ties

Ties are extension objects that handle the association between two graphic objects. While you can create a great deal of specialized CAD functionality by developing custom Regen graphics, only by writing a tie server can you build logic that depends on the interaction of two or more graphics.

Tie servers are Automation servers, where the TurboCAD engine is the client. A tie server creates one or more automation objects, through the standard COM creation system. Each automation object must support a standard suite of methods and properties, necessary to support the tie architecture.

Tie extensions are loaded when TurboCAD first starts up. To be successfully loaded, a tie extension DLL must be located in the Ties subdirectory of the TurboCAD engine's Program directory. Each module (DLL) in this directory is queried for a type library that tells TurboCAD what extensions are served by the module. Then the module's automation object or objects are created. For each installed tie object server, TurboCAD creates a corresponding TieMethod object that is added to the Application object's TieMethods collection.

Unlike the other extension server types, TurboCAD does not use the IDispatch (or "late-binding") method when communicating with tie servers. Instead these servers must implement the ITurboCADSmartTieServer COM interface, so that TurboCAD can use so-called VTBL (or "early-binding") for better performance.

Tie Servers and the TieSets, TieSet and Tie Objects

Each Drawing contains a TieSets collection, representing all the associations between graphics contained within the Drawing. Each TieSet item in the TieSets collection is a collection representing a group of related associations between a single pair of Graphic objects: the "subject" graphic and the "subordinate" graphic. The Tie server's job is to cause the subordinate Graphic to be modified when user actions change the geometry or properties of the subordinate graphic. For example, in the TextAlongCurve example, the curve or polyline graphic that the text follows is the subject, and the text elements that are displayed along the curve are the subordinate graphics. In some cases you want to make the two graphics in a particular tie equivalent. This is accomplished by establishing two ties, the subject and subordinate roles in one tie are reversed in the other.

The items in the TieSet collection are Tie objects. Each Tie object is single subject-subordinate relationship between specific parts of the two graphics.

In addition to specifying the two graphics involved in the association, Tie objects have a Priority property that establishes a ranking in case of conflict, and a Data property that holds the data that maintains the geometrical state of the Tie as the subordinate and subject Graphics change.

In some instances there are reciprocal subordinate-subject associations that can also affect the interaction of the two Graphics involved. The Tie server must negotiate these potentially conflicting interactions.

The Tie and TieSet associations are usually created by a custom tool, whose job it is to identify the subject and subordinate Graphic objects, create or find the TieSet that links the two graphics, and then create or update the Tie objects in the set, establishing the connection information based on user interaction. In addition, you can further implement special association behavior by building custom Regen objects for the subject and/or subordinate Graphics maintained in your ties.

Once a Tie is created or modified, the custom tie server responds to notifications by examining the Tie data and the state of the subordinate and subject Graphics.

Describe initialization, tie operation, subjects and subordinates

ITurboCADSmartTieServer Properties
Property | Description
Description | A String giving a short, human readable description for the server.
ITurboCADSmartTieServer Methods
Method | Description
Initialize | Called at startup. Your method can create any necessary internal data structures.
AddTie | Called whenever a new custom Tie is created.
DeleteTie | Called whenever a custom Tie is destroyed.
CopyTie | Called whenever a subject or subordinate Graphic (or both) in an existing Tie is copied.
UpdateTie | Called after subject Graphic has changed, so that server can update subordinate Graphic.
CanNODEED | Called just before TurboCAD runs a NodeEdit dragger, where the selection includes a Tie.
GetTypesInfo | Not used.
GetIDs | Not used.
SetIDs | Not used.


Coding a Tie

Because building interesting behaviors using ties can involve a considerable amount of logic, the documentation will provide information only about the most general aspects of writing a tie server. For detailed information consult the tie server examples that come with the SDK:

  • The VertexTie Tie example in Visual Basic provides a basic introduction to writing a custom tie server. The tie server connects. The ties are established by a VBA Macro also called VertexTie.
  • The TextAlongCurve Tie example requires a much more sophisticated approach to maintaining the tie information. The ties are created by a Visual Basic tool called TextAlongCurve.
  • The SurveyorCoordinate Tie example uses the tool to create the ties, and a custom "CoordReg" Regen type to display the coordinate data.

VTBL Binding and the ITurboCADSmartTieServer Interface

Since tie servers use VTBL binding, there are few differences from other extension types that must be observed when coding.

In Visual Basic you must make sure that the class module that implements your tie server contains the statement:

Implements ITurboCADSmartTieServer

In addition, the full suite of tie server methods and properties must be written using Visual Basic's naming conventions, so that the AddTie method is declared as:

Private Function ITurboCADSmartTieServer_AddTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, ByVal lType As Long) As Boolean

Identifying Tie Servers

Each tie server must be uniquely named through its ProgID. In Visual Basic, the tie server's ProgID is derived from the project name and the class module name. For instance the ProgID for the VertexTie sample is "VertexTie.clsVertexTie". This ID string is the one that you specify when adding ties using the TieSets.Add and TieSet.AddTie methods.


Maintaining Private Data in a Custom Tie

Each tie server uses a user-defined data type to hold information that it needs to keep track of the tie. In the simplest case (as illustrated by the VertexTie example), this can be just the vertex indices of the particular vertices in the subject and subordinate graphics that will be tied together. More elaborate servers, such as the TextAlongCurve example, need to keep track of more information. In Visual Basic, you can declare the user defined type for your Tie's data using a Type statement block in your tie server class module. Here is the user-defined type from the TextAlongCurve example:

Public Type VertexTieData
    idVertPoly As Long ' define the least nearest index of segment's vertex on polygon
    xLocRelPrev As Double ' Previous local coordinate on line segment
    AnglePrev As Double ' Previous angle of line segment
    fiMidPrev As Double ' Previous angle for middle text point for Circle or Arc
    xcPrev As Double    ' Previous Xc for Circle or Arc
    ycPrev As Double    ' Previous Yc for Circle or Arc
    LFullPrev As Double     ' Previous full length for Curve or TCW50Polyline
    x0Prev As Double    ' Previous x0 for Curve or TCW50Polyline
    y0Prev As Double    ' Previous y0 for Curve or TCW50Polyline
    x1Prev As Double    ' Previous x1 for Curve or TCW50Polyline
    y1Prev As Double    ' Previous y1 for Curve or TCW50Polyline
    L0RelPrev As Double  ' Previous relative Length coordinate for the center vertex of the text
    L1RelPrev As Double ' Previous relative Length coordinate for the first bounded vertex of the text
    L2RelPrev As Double ' Previous relative Length coordinate for the first bounded vertex of the text
End Type

NOTE You are limited to using integers, floating point numbers, Boolean values and arrays of these types as fields in your user-defined type. String values are not currently supported by TurboCAD, and will cause errors.

Once defined, other modules (such as the tool that creates the tie, or a custom Regen object that is used by the tie) can access and modify this data. For instance, the TextAlongCurve example keeps track of the previous location of the tie by examining and modifying this data. These other modules do not need to declare or define the data type. Instead, they can access the fields of the user-defined type by simply using the field names. In Visual Basic, you can accomplish this as follows (code is from the TextAlongCurve tool):

Dim TSet As TieSet
Dim varData As Variant
Dim theTie As Tie
    Set theTie = TSet(0)
    varData = theTie.Data
Dim AnglePrev As Double
Dim ConVertex As Long
    ConVertex = varData(0).idVertPoly
    AnglePrev = varData(0).AnglePrev

Note that you receive a copy of the Tie object data in a Variant variable, and then must index this Variant (which is actually returned as an array of VertexTieData of length 1), before using the field name. When you have made changes to the the user-defined data, you can copy the data back to the Tie object as follows:

    theTie.Data = varData(0)


Creating Ties

When a client (usually a tool or macro) calls TieSets.Add with the ID of your tie server and a subject-subordinate graphic pair, the ITurboCADSmartTieServer_AddTie method of your server will be called. It is up to your server to actually create the tie by setting up the private tie data (as contained in your user-defined data type) and then calling TieSet.AddTie. In the VertexTie example, TieSets.Add is called twice, and the server detects this by checking to see if the TieSet specified by the subject and subordinate contains any Tie objects. The server actually constructs a reciprocal pair of Ties, swapping the subject and subordinate roles in the second Tie:

Private idVTie As String
Private gxTSets As TieSets
Private gxTSet  As TieSet
Private gxTie   As Tie
Private gxDwg   As Drawing
Private tieData As VertexTieDataPrivate
Function ITurboCADSmartTieServer_AddTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, ByVal lType As Long) As Boolean
    Dim varData As Variant
    Set gxDwg = pIDispDwg

    Set gxTSets = gxDwg.TieSets
    Set gxTSet = gxTSets.TieSet(idSbj, idSbd)
    If (gxTSet.Count = 0) Then
        tieData.idVrtSbj = lType
        tieData.idVrtSbd = -1
        varData = tieData
        gxTSet.AddTie idVTie, 1, varData
    Else
        Set gxTie = gxTSet(0)
        varData = gxTie.Data
        tieData = varData(0)
        tieData.idVrtSbd = lType
        varData = tieData
        gxTie.Data = tieData
    End If

    Set gxTSet = gxTSets.TieSet(idSbd, idSbj)
    If (gxTSet.Count = 0) Then
        tieData.idVrtSbj = -1
        tieData.idVrtSbd = lType
        varData = tieData
        gxTSet.AddTie idVTie, 1, varData
    Else
        Set gxTie = gxTSet(0)
        varData = gxTie.Data
        tieData = varData(0)
        tieData.idVrtSbj = lType
        varData = tieData
        gxTie.Data = tieData
    End If

    UpdateTie gxTSet
    ITurboCADSmartTieServer_AddTie = True
    Clear

End Function


Updating Ties

Whenever a Graphic object that is the subject of a drawing's TieSet is modified, the TurboCAD engine calls the TieSet's server's ITurboCADSmartTieServer_UpdateTie method. In the VertexTie sample, this method just find the appropriate TieSet and delegates to a private function called UpdateTie (which is also called from the AddTie method):

Private Function ITurboCADSmartTieServer_UpdateTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Integer
    Set gxDwg = pIDispDwg
    Set gxTSets = gxDwg.TieSets
    Set gxTSet = gxTSets.TieSet(idSbj, idSbd)
    UpdateTie gxTSet

    ITurboCADSmartTieServer_UpdateTie = 0
    Clear
End Function

The code in the UpdateTie method moves the vertex in the subordinate graphic so that it is located at the same position as the tied vertex in the subject graphic. It also redraws the modified subordinate graphic twice (erasing the old version of the graphic by temporarily setting the graphic's Deleted flag to True, and then drawing the graphic in its new configuration after the vertex has been moved):

Private Function UpdateTie(ByRef gxTSet As TieSet)

    Dim gxVrtSbj As Vertex
    Dim gxVrtSbd As Vertex
    Dim varData As Variant
    Dim gxGrSbdNew As Graphic

    Dim gxDwg As Drawing
    Dim hDwg As Long
    Dim hGrSbd As Long
    Dim idSbd As Long

    Set gxTie = gxTSet(0)

    varData = gxTie.Data
    tieData = varData(0)

    If (tieData.idVrtSbd <> -1 And tieData.idVrtSbj <> -1) Then

            Set gxGrSbj = gxTSet.Subject
            Set gxGrSbd = gxTSet.Subordinate

            Set gxVrtsSbj = gxGrSbj.Vertices
            Set gxVrtsSbd = gxGrSbd.Vertices

            gxVrtsSbj.UseWorldCS = True
            gxVrtsSbd.UseWorldCS = True

            Set gxVrtSbj = gxVrtsSbj(tieData.idVrtSbj)
            Set gxVrtSbd = gxVrtsSbd(tieData.idVrtSbd)

            gxGrSbd.Deleted = True
            gxGrSbd.Draw
            gxGrSbd.Deleted = False

            gxVrtSbd.X = gxVrtSbj.X
            gxVrtSbd.Y = gxVrtSbj.Y
            gxVrtSbd.Z = gxVrtSbj.Z

            gxGrSbd.Draw

            Set gxVrtSbd = Nothing
            Set gxVrtSbj = Nothing
            Set gxGrSbj = Nothing
            Set gxGrSbd = Nothing
    End If
End Function


Copying Ties

When TurboCAD copies the two graphics contained in a Tie, it calls your server's ITurboCADSmartTieServer_CopyTie method, so that you can make any adjustments to preserve important relationships in the copied objects. The VertexTie example needs to make sure that a new reciprocal Tie pair is established with the same private data (vertex information) as in the original. It does this by calling TieSets.Add on the copied graphics, which will invoke the tie creation process just as if an external client were creating the new Ties:

Private Function ITurboCADSmartTieServer_CopyTie(ByVal pIDispDwg As Object, ByVal idSbjSrc As Long, ByVal idSbdSrc As Long, ByVal idSbjTrg As Long, ByVal idSbdTrg As Long) As Boolean

    Set gxDwg = pIDispDwg
    Set gxGrs = gxDwg.Graphics
    Set gxGrSbj = gxGrs.GraphicFromID(idSbjTrg)
    Set gxGrSbd = gxGrs.GraphicFromID(idSbdTrg)

    Set gxTSets = gxDwg.TieSets
    Set gxTSet = gxTSets.TieSet(idSbjSrc, idSbdSrc)
    Set gxTie = gxTSet(0)
    tieData = gxTie.Data

    Set gxTSet = gxTSets.Add(idVTie, gxGrSbj, gxGrSbd, tieData.idVrtSbj, 0)

    Set gxTie = gxTSet(0)
    gxTie.Data = tieData

    Clear

    ITurboCADSmartTieServer_CopyTie = True
End Function


Destroying Ties

If one or the other of the graphics in a Tie are deleted, TurboCAD will call your server's ITurboCADSmartTieServer_DeleteTie method. This gives you a chance to make any adjustments necessary before your Tie is removed, and the private Tie data destroyed. The VertexTie example doesn't need to do any special processing here, so its implementation is empty:

Private Function ITurboCADSmartTieServer_DeleteTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, ByVal pIDsipGr As Object) As Boolean
    ITurboCADSmartTieServer_DeleteTie = True
End Function


Installing and Debugging Tie Servers

To install and debug your custom tie server, follow the guidelines given in the section "Installing and Debugging Custom Regen Object Servers", placing the tie DLL in the Ties subdirectory of the TurboCAD engine's Program directory.


Adding a Tie from a Tool or Macro

Once you have created and installed your tie server, you can write a custom tool or VBA macro that will create the association between the subject and subordinate Graphics. To do this, you call the TieSets.Add method, passing the ProgID of the tie server, the two graphics and a user-definable Long value that will be passed to the tie server's ITurboCADSmartTieServer_AddTie method. In the VertexTie macro, the event handler captures mouse down events to select two graphics and then calls:

        gxTSets.Add "VertexTie.clsVertexTie", gxGrSbj, gxGrSbd, 0, 0
        gxTSets.Add "VertexTie.clsVertexTie", gxGrSbj, gxGrSbd, 1, 0


Creating Custom Palettes

Palettes are extension objects that handle the association between two graphic objects. Palette servers are Automation servers, where the TurboCAD engine is the client. A palette server creates one or more automation objects, through the standard COM creation system. Each automation object must support a standard suite of methods and properties, necessary to support the palette architecture.

Palette extensions are loaded when TurboCAD first starts up. To be successfully loaded, a palette extension DLL must be located in the Palettes subdirectory of the TurboCAD engine's Program directory. Each module (DLL) in this directory is queried for a type library that tells TurboCAD what extensions are served by the module. Then the module's automation object or objects are created. For each installed palette object server, TurboCAD creates a corresponding Palette object that is added to the Application object's Palettes collection.

Describe initialization, palette operation

The palette server object must implement an IDispatch or dual interface that includes all the methods and properties of the ITurboCADPaletteServer interface:

Describe methods

ITurboCADPaletteServer Properties
Property | Description
Description | A String giving a short, human readable description for the server.
Name |
HelpID |
Picture |
ITurboCADPaletteServer Methods
Method | Description
CreatePltWindow |
Query |


Coding a Palette

TODO


Installing and Debugging Palettes

TODO


Writing Scripts for the Internet Palette

TODO


Example Projects

All of the code examples that ship with the SDK are listed in the following sections. Each example page contains instructions on how you can build and run the program, as well as links to the text source code files, so that you can cut and paste source code directly from the documentation into your projects.

Projects are arranged by language/development environment, and then by the type of project:

Visual Basic for Applications Examples

These are simple and complex macros that run in the TurboCAD and Microsoft Office VBA system, allowing you to automate many procedures and perform data transfer into and out of TurboCAD.

Visual Basic Examples

These include standalone applications, ActiveX controls, a filter that saves data to the .XLS file format, custom "regen" graphics that let you create parametrically defined objects in your drawings, tie projects demonstrating how to link graphics together, and custom tools that extend the TurboCAD user interface to a level beyond simple macros.

Visual C++ Examples

In addition to all the types of projects included in the Visual Basic examples, this collection also includes an example of creating a custom palette server object that you can integrate into TurboCAD's palette user interface.

VBScript Examples

These examples show how to control TurboCAD using VBScript (one of a number of free scripting languages available for Windows programmers). The examples illustrate how you can create scriptlets embedded within HTML pages that ared designed to be used with TurboCAD's internet palette, and how you can control TurboCAD from the command line or GUI Windows Script Host controllers that are part of Windows 98, 2000, and XP.


Application Environment Macro Example

Description

This example shows TODO.

Components

AppEnv.exe (Web link) Self-extracting project archive.

modAppEnv.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Basic Analysis Macro Example

Description

This example shows TODO.

Components

BasicAnalysis.exe (Web link) Self-extracting project archive.

modGeom.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Blocks Macro Example

Description

This example shows TODO.

Components

Blocks.exe (Web link) Self-extracting project archive.

modBlocks.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Bolt Macro Example

Description

This example shows TODO.

Components

Bolt.exe (Web link) Self-extracting project archive.

frmBolt.frm Source file.

modBolt.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Camera Macro Example

Description

This example shows TODO.

Components

Camera.exe (Web link) Self-extracting project archive.

frmBitmapTest.frm Source file.

frmCamera.frm Source file.

modCamera.bas Source file.

ViewPict.cpp Source file.

ViewPict.h Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Cloud Macro Example

Description

This example shows TODO.

Components

Cloud.exe (Web link) Self-extracting project archive.

Cloud1.bas Source file.

modCloud.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Common Macro Modules Example

Description

This example shows TODO.

Components

Common.exe (Web link) Self-extracting project archive.

modGraphicOps.bas Source file.

modProperties.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Bezier Curve Macro Example

Description

This example shows TODO.

Components

CurveBezier.exe (Web link) Self-extracting project archive.

DrawCurveBezier.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Double Line 2 Macro Example

Description

This example shows TODO.

Components

DblLine2.exe (Web link) Self-extracting project archive.

modDblLine2.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Double Line Macro Example

Description

This example shows TODO.

Components

DblLine.exe (Web link) Self-extracting project archive.

modDblLine.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Edit Circle Macro Example

Description

This example shows TODO.

Components

EditCircle.exe (Web link) Self-extracting project archive.

frmEditCircle.frm Source file.

modEditCircle.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Events Macro Example

Description

This example shows TODO.

Components

Events.exe (Web link) Self-extracting project archive.

clsEvents.cls Source file.

frmEvents.frm Source file.

modEvents.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


TurboCAD in Excel Macro Example

Description

This example shows TODO.

Components

Excel2.exe (Web link) Self-extracting project archive.

modTcContour.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Excel Import Macro Example

Description

This example shows TODO.

Components

ExcelImport.exe (Web link) Self-extracting project archive.

ImportFromExcelspreadSheet.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Excel Topographic Data Macro Example

Description

This example shows TODO.

Components

Excel.exe (Web link) Self-extracting project archive.

modContour.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Extended Selection Info Macro Example

Description

This example shows TODO.

Components

ExtendedSelInfo.exe (Web link) Self-extracting project archive.

frmSelInfo.frm Source file.

modSelInfo.bas Source file.

modSelNode.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Extrude Text Example

Description

This Visual Basic for Applications example shows how to create flexible text graphics, use the Explode method to convert a text graphic to polylines that represent the outlines of each character in the text, and to build 3D extrusions from each of the text characters. The TCM file contains one module with a single macro that produces the 3D extrusions in the active drawing.

Components

ExtrudeText.exe (Web link) Self-extracting archive containing ExtrudeText.tcm VBA project.

modExtrudeText.bas Source file.

Build Instructions

Download and unpack the self-extracting archive. Add a new project named "ExtrudeText" to any TurboCAD drawing, and attach the ExtrudeText.tcm file. Run the CreateExtrudedText macro and observe the results, a series of 3D extrusions.


Gear Macro Example

Description

This example shows TODO.

Components

Gear.exe (Web link) Self-extracting project archive.

frmGear.frm Source file.

modGear.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Graphic Methods Macro Example

Description

This example shows TODO.

Components

Graphic.exe (Web link) Self-extracting project archive.

Graphics1.bas Source file.

Graphics2.bas Source file.

IGraphic.bas Source file.

modGraphicCollections.bas Source file.

mView.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Nut Macro Example

Description

This example shows TODO.

Components

Nuts.exe (Web link) Self-extracting project archive.

frmNuts.frm Source file.

modNuts.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Paper Space Macro Example

Description

This example shows TODO.

Components

PaperSpace.exe (Web link) Self-extracting project archive.

modPS.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Printing Macro Example

Description

This example shows TODO.

Components

Printing.exe (Web link) Self-extracting project archive.

modPrint.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Selection Property Macro Example

Description

This example shows TODO.

Components

PropSel.exe (Web link) Self-extracting project archive.

frmColorPalette.frm Source file.

frmPropSel.frm Source file.

modPropSel.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Rounded Rectangle Macro Example

Description

This example shows TODO.

Components

RRect.exe (Web link) Self-extracting project archive.

frmRRect.frm Source file.

modRRect.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Rendering Macro Example

Description

This example shows TODO.

Components

Render.exe (Web link) Self-extracting project archive.

frmRender.frm Source file.

modRender.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


LineStyles and BrushStyles Macro Example

Description

This example shows TODO.

Components

Styles.exe (Web link) Self-extracting project archive.

modStyles.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Text Macro Example

Description

This example shows TODO.

Components

Text.exe (Web link) Self-extracting project archive.

modText.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Title Block Example

Description

This Visual Basic for Applications example shows how to create a simple title block, and to set the drawing scale and units for a new drawing.

Components

TitleBlock.exe (Web link) Self-extracting archive containing TitleBlock.tcm VBA project.

modTitleBlock.bas Source file.

Build Instructions

Download and unpack the self-extracting archive. Add a new project named "TitleBlock" to any TurboCAD drawing, and attach the TitleBlock.tcm file. Run the SetTitleBlock macro and observe the results, a simple title block added to the drawing.


Vertex Methods Macro Example

Description

This example shows TODO.

Components

Vertex.exe (Web link) Self-extracting project archive.

DialogBox.frm Source file.

IVertex.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Viewport Macro Example

Description

This example shows TODO.

Components

ViewPort.exe (Web link) Self-extracting project archive.

modViewport.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


XRef Macro Example

Description

This example shows TODO.

Components

XRef.exe (Web link) Self-extracting project archive.

mAddViewportTst.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


File Converter Application Example

Description

This example shows TODO.

Components

Converter.exe (Web link) Self-extracting project archive.

frmConverter.frm Source file.

modConverter.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Matrix Example

Description

This example shows TODO.

Components

Matrix.exe (Web link) Self-extracting project archive.

matrix.frm Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Preview Example

Description

This example shows TODO.

Components

Preview.exe (Web link) Self-extracting project archive.

Preview.Frm Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


TCADX Example

Description

This example shows TODO.

Components

TCADX.exe (Web link) Self-extracting project archive.

Camera1.bas Source file.

clsTCADX.cls Source file.

dlgCoords.frm Source file.

dlgDrawings.frm Source file.

dlgSelectDrawing.frm Source file.

flgTCADEvents.frm Source file.

frmTCADX.frm Source file.

mdlTCADX.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


TurboCAD Viewer Example

Description

This example shows TODO.

Components

TCView.exe (Web link) Self-extracting project archive.

frmVbCamera.frm Source file.

modTCView.bas Source file.

modVbCamera.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Excel Filter Example

Description

This example shows TODO.

Components

ExcelFlt.exe (Web link) Self-extracting project archive.

Excel.cls Source file.

modExExport.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


3D Bolts Regen Example

Description

This example shows TODO.

Components

Bolt3D.exe (Web link) Self-extracting project archive.

clsBolt3D.cls Source file.

frmBolt3D.frm Source file.

modBolt3D.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Bolts and Nuts Regen Example

Description

This example shows TODO.

Components

BoltNut.exe (Web link) Self-extracting project archive.

clsBoltNut.cls Source file.

frmBoltNut.frm Source file.

modBoltNut.bas Source file.

ScriptB_N.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Cable Regen Example

Description

This example shows TODO.

Components

Cable.exe (Web link) Self-extracting project archive.

clsCable.cls Source file.

frmCable.frm Source file.

modCable.bas Source file.

ScriptCable.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Connection Line Regen Example

Description

This example shows TODO.

Components

ConnectionLine.exe (Web link) Self-extracting project archive.

CCC.frm Source file.

Conn.bas Source file.

Line.cls Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Coord Text Regen Example

Description

This example shows TODO.

Components

CoordText.exe (Web link) Self-extracting project archive.

CoordText.bas Source file.

CoordText.cls Source file.

CoordText.frm Source file.

createct.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Datum Target Regen Example

Description

This example shows TODO.

Components

DatumTarget.exe (Web link) Self-extracting project archive.

DatumTarg.bas Source file.

DatumTarg.cls Source file.

DatumTarg.frm Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Fastener Regen Example

Description

This example shows TODO.

Components

Fasteners.exe (Web link) Self-extracting project archive.

clsFasteners.cls Source file.

frmFasteners.frm Source file.

modFasteners.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Hole Regen Example

Description

This example shows TODO.

Components

Holes.exe (Web link) Self-extracting project archive.

frmHole.frm Source file.

Hole.bas Source file.

Hole.cls Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


3D Nut Regen Example

Description

This example shows TODO.

Components

Nut3d.exe (Web link) Self-extracting project archive.

Nut3.bas Source file.

Nut3.cls Source file.

Nut3.frm Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Gear Regen Example

Description

This example shows TODO.

Components

RGear.exe (Web link) Self-extracting project archive.

Gear.bas Source file.

Gear.cls Source file.

Gear.frm Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


2D Nut Regen Example

Description

This example shows TODO.

Components

RNuts.exe (Web link) Self-extracting project archive.

Nut2.bas Source file.

Nut2.cls Source file.

Nut2.frm Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Rounded Rectangle Regen Example

Description

This example shows TODO.

Components

RRRect.exe (Web link) Self-extracting project archive.

RRect.bas Source file.

RRect.cls Source file.

RRect.frm Source file.

CREATERR.BAS Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Tolerance Symbol Regen Example

Description

This example shows TODO.

Components

RegToler.exe (Web link) Self-extracting project archive.

ChooseFont.frm Source file.

DatRef.bas Source file.

DatRef.cls Source file.

DatRef.frm Source file.

TolMC.frm Source file.

TolSymbol.frm Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Roughness Symbol Regen Example

Description

This example shows TODO.

Components

Roughness.exe (Web link) Self-extracting project archive.

Lay.frm Source file.

Rough.bas Source file.

Rough.cls Source file.

Rough.frm Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Text Box Regen Example

Description

This example shows TODO.

Components

TextBox.exe (Web link) Self-extracting project archive.

Box.bas Source file.

Box.cls Source file.

box.frm Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Welding Symbol Regen Example

Description

This example shows TODO.

Components

WeldingSymbol.exe (Web link) Self-extracting project archive.

TailReference.frm Source file.

Weld.bas Source file.

Weld.cls Source file.

Weld.frm Source file.

WeldBotSymbols.frm Source file.

WeldMidSymbols.frm Source file.

WeldTopSymbols.frm Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Radial Dimension Tie Example

Description

This example shows TODO.

Components

RadDimTie.exe (Web link) Self-extracting project archive.

RadDimTie.cls Source file.

modRadDimTie.bas Source file.

radimtie.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Vertex Tie Example

Description

This example shows TODO.

Components

VertexTie.exe (Web link) Self-extracting project archive.

VertexTie.cls Source file.

clsTCEventHandler.cls Source file.

modAddVertexTie.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


2D Boolean Tool Example

Description

This example shows TODO.

Components

Bool2D.exe (Web link) Self-extracting project archive.

Bool2D.cls Source file.

modBool2D.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


File Converter Tool Example

Description

This example shows TODO.

Components

FileConverterTool.exe (Web link) Self-extracting project archive.

Converter.bas Source file.

Converter.cls Source file.

Converter.frm Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Gear Contour Tool Example

Description

This example shows TODO.

Components

GearContour.exe (Web link) Self-extracting project archive.

GearContour.bas Source file.

GearContour.cls Source file.

GearContour.frm Source file.

SaveFile.frm Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Internet Hyperlink Tool Example

Description

This example shows TODO.

Components

Inet.exe (Web link) Self-extracting project archive.

Inet.bas Source file.

Inet.cls Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Joint Tool Example

Description

This example shows TODO.

Components

Joint.exe (Web link) Self-extracting project archive.

Joint.bas Source file.

Joint.cls Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Plane Figure Parameter Tool Example

Description

This example shows TODO.

Components

PlaneFigureParameters.exe (Web link) Self-extracting project archive.

Parameters.bas Source file.

Parameters.cls Source file.

Parameters.frm Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Surveyor Dimension Tool Example

Description

This example shows TODO.

Components

SurveyorDimension.exe (Web link) Self-extracting project archive.

SurvTool.bas Source file.

SurvTool.cls Source file.

SurvReg.bas Source file.

SurvReg.cls Source file.

SurvReg.frm Source file.

SurvTie.cls Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Text Along Curve Tool Example

Description

This example shows TODO.

Components

TextAlong.exe (Web link) Self-extracting project archive.

clsToolTextAlong.cls Source file.

frmToolTextAlong.frm Source file.

modToolTextAlong.bas Source file.

clsTextAlong.cls Source file.

frmTextAlong.frm Source file.

modTextAlong.bas Source file.

CurveTextTie.cls Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


SDK Regen Tool Example

Description

This example shows TODO.

Components

ToolRegen.exe (Web link) Self-extracting project archive.

clsToolReg.cls Source file.

frmToolReg.frm Source file.

modToolReg.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Internet Palette Scripts Example

Description

This example shows TODO.

Components

HtmlScriptPack.exe (Web link) Self-extracting project archive.

&Calculator.htm Source file.

C&urveLab.htm Source file.

D&rawingView.htm Source file.

Demo%20ScreenCam.htm Source file.

S&elInfo.htm Source file.

Scr&iptLab.htm Source file.

SDK Sample Calculator.htm Source file.

SDK Sample DrawingTree.htm Source file.

SDK Sample ID Keeper.htm Source file.

SDK Sample ShowFirstGraphic.htm Source file.

SDK Sample ShowUCS.htm Source file.

SDK Sample TC Ver.htm Source file.

SDK Sample Template.htm Source file.

SDK Sample ToolBar.htm Source file.

StBase.htm Source file.

StCalculator.htm Source file.

StDrawingTree.htm Source file.

StLabel.htm Source file.

StListView.htm Source file.

StObjectBase.htm Source file.

StTC.htm Source file.

StTemplate.htm Source file.

StText.htm Source file.

StToolBar.htm Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


Script Host Scripts Example

Description

This example shows TODO.

Components

WshScriptPack.exe (Web link) Self-extracting project archive.

turboCAD Test1.vbs Source file.

TurboCAD test2.vbs Source file.

TurboCAD Test3.vbs Source file.

TurboCAD Test4.vbs Source file.

TurboCADTest5 .vbs Source file.

TurboCADTest6.vbs Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


C++ Events Example

Description

This example shows TODO.

Components

CPPEvents.exe (Web link) Self-extracting project archive.

EVENTDLG.CPP Source file.

EVENTDLG.H Source file.

EVENTS.CPP Source file.

EVENTS.H Source file.

Mfcdual.cpp Source file.

MFCDUAL.H Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


C++ LineType Example

Description

This example shows TODO.

Components

LTSample.exe (Web link) Self-extracting project archive.

AddProperty.cpp Source file.

AddProperty.h Source file.

AddSymbolDlg.cpp Source file.

AddSymbolDlg.h Source file.

DlgProxy.cpp Source file.

DlgProxy.h Source file.

imsigx50.cpp Source file.

LTSample.cpp Source file.

LTSample.h Source file.

LTSampleDlg.cpp Source file.

LTSampleDlg.h Source file.

PropDialog.cpp Source file.

PropDialog.h Source file.

PropModify.cpp Source file.

PropModify.h Source file.

QueryDialog.cpp Source file.

QueryDialog.h Source file.

QueryHelpDlg.cpp Source file.

QueryHelpDlg.h Source file.

SelOptPage.cpp Source file.

SelOptPage.h Source file.

SmartObjectInserDlg.cpp Source file.

SmartObjectInserDlg.h Source file.

VPWnd.cpp Source file.

VPWnd.h Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


C++ MakeDwg Example

Description

This example shows TODO.

Components

MakeDwg.exe (Web link) Self-extracting project archive.

MakeDwg.cpp Source file.

MakeDwg.h Source file.

MDDialog.cpp Source file.

MDDialog.h Source file.

MDDlog2.cpp Source file.

VPWnd.cpp Source file.

VPWnd.h Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


C++ ActiveX Control Example

Description

This example shows TODO.

Components

OCXDemo.exe (Web link) Self-extracting project archive.

BlockInsertDialog.cpp Source file.

BlockInsertDialog.h Source file.

SDKDemo.cpp Source file.

SDKDemo.h Source file.

SDKDemoCtl.cpp Source file.

SDKDemoCtl.h Source file.

SDKDemoPpg.cpp Source file.

SDKDemoPpg.h Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


C++ JPEG Filter Example

Description

This example shows TODO.

Components

JPEG.exe (Web link) Self-extracting project archive.

AutoJPEG.cpp Source file.

AutoJPEG.h Source file.

JPEG.CPP Source file.

JPEG.H Source file.

Mfcdual.cpp Source file.

Mfcdual.h Source file.

WSetup.cpp Source file.

WSetup.h Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


C++ Palette Example

Description

This example shows TODO.

Components

CustomPalette.exe (Web link) Self-extracting project archive.

CustomPalette.cpp Source file.

CustomPalette.h Source file.

PalDlg.cpp Source file.

PalDlg.h Source file.

pltapi.cpp Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


C++ Rounded Rectangle 2 Regen Example

Description

This example shows TODO.

Components

CPPRRectA.exe (Web link) Self-extracting project archive.

AutoRect.cpp Source file.

AutoRect.h Source file.

RectPage.cpp Source file.

RectPage.h Source file.

RRectA.cpp Source file.

RRectA.h Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


C++ Rounded Rectangle Regen Example

Description

This example shows TODO.

Components

CPPRRect.exe (Web link) Self-extracting project archive.

AUTORECT.CPP Source file.

AUTORECT.H Source file.

Mfcdual.cpp Source file.

Mfcdual.h Source file.

RECTPAGE.CPP Source file.

RECTPAGE.H Source file.

RRECT.CPP Source file.

RRECT.H Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


C++ Spline Regen Example

Description

This example shows TODO.

Components

Spline.exe (Web link) Self-extracting project archive.

AutoSpl.cpp Source file.

AutoSpl.h Source file.

Mfcdual.cpp Source file.

Mfcdual.h Source file.

MfcSplin.cpp Source file.

MfcSplin.h Source file.

SplPage.cpp Source file.

SplPage.h Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


C++ Printing Server Example

Description

This example shows TODO.

Components

PrintCAD.exe (Web link) Self-extracting project archive.

PrintCAD.cpp Source file.

PrintCAD.h Source file.

PrintDr.cpp Source file.

PrintDr.h Source file.

frmSamplePrint.frm Source file.

modSamplePrint.bas Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


C++ Server Example

Description

This example shows TODO.

Components

TCADEX.exe (Web link) Self-extracting project archive.

dlldatax.h Source file.

TBool.cpp Source file.

TBool.h Source file.

TCADEX.cpp Source file.

TCADEX.h Source file.

TRender.cpp Source file.

TRender.h Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


C++ Insert External Symbol Tool Example

Description

This example shows TODO.

Components

InsertExternalSymbol.exe (Web link) Self-extracting project archive.

ExSymbol.cpp Source file.

ExSymbol.h Source file.

InsertExternalSymbol.cpp Source file.

InsertExternalSymbol.h Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


C++ Insert Regen Object Tool Example

Description

This example shows TODO.

Components

InsertRegenObject.exe (Web link) Self-extracting project archive.

events.h Source file.

InsSmObj.cpp Source file.

SdiDialog.cpp Source file.

SdiDialog.h Source file.

SmObj.cpp Source file.

SmObj.h Source file.

ToolList.cpp Source file.

ToolList.h Source file.

ViewWnd.cpp Source file.

ViewWnd.h Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


C++ Insert Symbol Tool Example

Description

This example shows TODO.

Components

InsertSymbol.exe (Web link) Self-extracting project archive.

dirdialog.CPP Source file.

dirdialog.H Source file.

InsSymb.cpp Source file.

InsSymb.h Source file.

InsTool.cpp Source file.

InsTool.h Source file.

Merge.cpp Source file.

Merge.h Source file.

TCINTF.H Source file.

TDialog.cpp Source file.

TDialog.h Source file.

TDialog1.cpp Source file.

TDialog1.h Source file.

ToolList.cpp Source file.

ToolList.h Source file.

ViewWnd.cpp Source file.

ViewWnd.h Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


C++ Wizard Example

Description

This example shows TODO.

Components

TCPssWiz.exe (Web link) Self-extracting project archive.

Begin.cpp Source file.

Begin.h Source file.

PaperOrientation.cpp Source file.

PaperOrientation.h Source file.

PaperSpaceWizard.cpp Source file.

PaperSpaceWizard.h Source file.

PSsWizard.cpp Source file.

PSsWizard.h Source file.

TCPssWiz.cpp Source file.

TCPssWiz.h Source file.

Build Instructions

Download and unpack the self-extracting archive.

More instructions


TurboCAD Object Reference

This section lists all the events, objects, methods and properties in the TurboCAD SDK.


BeforeDoubleClick Event

Occurs when [[[when]]]

Syntax

Sub object_BeforeDoubleClick(ByVal WhichDrawing As Drawing, ByVal WhichView As View, ByVal WhichWindow As Window, ByVal Sel As Selection, Cancel As Boolean)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

WhichWindow Required Window. [[[Describe Parameter Here]]]

Sel Required Selection. [[[Describe Parameter Here]]]

Cancel Required Boolean. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


BeforeExit Event

Occurs when [[[when]]]

Syntax

Sub object_BeforeExit(ByVal TheApp As Application, Cancel As Boolean)

TheApp Required Application. [[[Describe Parameter Here]]]

Cancel Required Boolean. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


BeforeRightClick Event

Occurs when [[[when]]]

Syntax

Sub object_BeforeRightClick(ByVal WhichDrawing As Drawing, ByVal WhichView As View, ByVal WhichWindow As Window, ByVal Sel As Selection, Cancel As Boolean)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

WhichWindow Required Window. [[[Describe Parameter Here]]]

Sel Required Selection. [[[Describe Parameter Here]]]

Cancel Required Boolean. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


CommandBarControlDone Event

Occurs when [[[when]]]

Syntax

Sub object_CommandBarControlDone(ByVal WhichControl As CommandBarControl)

WhichControl Required CommandBarControl. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


CommandBarControlHit Event

Occurs when [[[when]]]

Syntax

Sub object_CommandBarControlHit(ByVal WhichControl As CommandBarControl, Cancel As Boolean)

WhichControl Required CommandBarControl. [[[Describe Parameter Here]]]

Cancel Required Boolean. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


CommandBarControlStatus Event

Occurs when [[[when]]]

Syntax

Sub object_CommandBarControlStatus(ByVal WhichControl As CommandBarControl)

WhichControl Required CommandBarControl. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


DrawingActivate Event

Occurs when [[[when]]]

Syntax

Sub object_DrawingActivate(ByVal WhichDrawing As Drawing)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


DrawingAfterSave Event

Occurs when [[[when]]]

Syntax

Sub object_DrawingAfterSave(ByVal WhichDrawing As Drawing)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


DrawingBeforeClose Event

Occurs when [[[when]]]

Syntax

Sub object_DrawingBeforeClose(ByVal WhichDrawing As Drawing, Cancel As Boolean)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

Cancel Required Boolean. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


DrawingBeforeSave Event

Occurs when [[[when]]]

Syntax

Sub object_DrawingBeforeSave(ByVal WhichDrawing As Drawing, SaveAs As Boolean, Cancel As Boolean)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

SaveAs Required Boolean. [[[Describe Parameter Here]]]

Cancel Required Boolean. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


DrawingDeactivate Event

Occurs when [[[when]]]

Syntax

Sub object_DrawingDeactivate(ByVal WhichDrawing As Drawing)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


DrawingNew Event

Occurs when [[[when]]]

Syntax

Sub object_DrawingNew(ByVal WhichDrawing As Drawing)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


DrawingOpen Event

Occurs when [[[when]]]

Syntax

Sub object_DrawingOpen(ByVal WhichDrawing As Drawing)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


Drop Event

Occurs when [[[when]]]

Syntax

Sub object_Drop(ByVal WhichDrawing As Drawing, ByVal WhichView As View, ByVal WhichWindow As Window, ByVal Sel As Selection)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

WhichWindow Required Window. [[[Describe Parameter Here]]]

Sel Required Selection. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


MouseDown Event

Occurs when [[[when]]]

Syntax

Sub object_MouseDown(ByVal WhichDrawing As Drawing, ByVal WhichView As View, ByVal WhichWindow As Window, ByVal Button As ImsiMouseButton, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long, Cancel As Boolean)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

WhichWindow Required Window. [[[Describe Parameter Here]]]

Button Required ImsiMouseButton. [[[Describe Parameter Here]]]

Shift Required Long. [[[Describe Parameter Here]]]

X Required Long. [[[Describe Parameter Here]]]

Y Required Long. [[[Describe Parameter Here]]]

Cancel Required Boolean. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


MouseMove Event

Occurs when [[[when]]]

Syntax

Sub object_MouseMove(ByVal WhichDrawing As Drawing, ByVal WhichView As View, ByVal WhichWindow As Window, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long, Cancel As Boolean)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

WhichWindow Required Window. [[[Describe Parameter Here]]]

Shift Required Long. [[[Describe Parameter Here]]]

X Required Long. [[[Describe Parameter Here]]]

Y Required Long. [[[Describe Parameter Here]]]

Cancel Required Boolean. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


MouseUp Event

Occurs when [[[when]]]

Syntax

Sub object_MouseUp(ByVal WhichDrawing As Drawing, ByVal WhichView As View, ByVal WhichWindow As Window, ByVal Button As ImsiMouseButton, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long, Cancel As Boolean)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

WhichWindow Required Window. [[[Describe Parameter Here]]]

Button Required ImsiMouseButton. [[[Describe Parameter Here]]]

Shift Required Long. [[[Describe Parameter Here]]]

X Required Long. [[[Describe Parameter Here]]]

Y Required Long. [[[Describe Parameter Here]]]

Cancel Required Boolean. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


PointPick Event

Occurs when [[[when]]]

Syntax

Sub object_PointPick(ByVal WhichDrawing As Drawing, ByVal WhichView As View, ByVal Result As PickResult, ByVal PickWasCanceled As Boolean)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

Result Required PickResult. [[[Describe Parameter Here]]]

PickWasCanceled Required Boolean. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


PointSnapped Event

Occurs when [[[when]]]

Syntax

Sub object_PointSnapped(ByVal WhichDrawing As Drawing, ByVal WhichView As View, ByVal X As Long, ByVal Y As Long, ByVal PointRaw As Vertex, ByVal PointSnapped As Vertex)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

X Required Long. [[[Describe Parameter Here]]]

Y Required Long. [[[Describe Parameter Here]]]

PointRaw Required Vertex. [[[Describe Parameter Here]]]

PointSnapped Required Vertex. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


PolygonPick Event

Occurs when [[[when]]]

Syntax

Sub object_PolygonPick(ByVal WhichDrawing As Drawing, ByVal WhichView As View, ByVal Result As PickResult, ByVal PickWasCanceled As Boolean)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

Result Required PickResult. [[[Describe Parameter Here]]]

PickWasCanceled Required Boolean. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


RectanglePick Event

Occurs when [[[when]]]

Syntax

Sub object_RectanglePick(ByVal WhichDrawing As Drawing, ByVal WhichView As View, ByVal Result As PickResult, ByVal PickWasCanceled As Boolean)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

Result Required PickResult. [[[Describe Parameter Here]]]

PickWasCanceled Required Boolean. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


RunTool Event

Occurs when [[[when]]]

Syntax

Sub object_RunTool(ByVal WhichTool As Tool)

WhichTool Required Tool. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


SelectionChange Event

Occurs when [[[when]]]

Syntax

Sub object_SelectionChange(ByVal WhichDrawing As Drawing, ByVal WhichView As View, ByVal WhichWindow As Window, ByVal Sel As Selection)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

WhichWindow Required Window. [[[Describe Parameter Here]]]

Sel Required Selection. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


ViewAfterRedraw Event

Occurs when [[[when]]]

Syntax

Sub object_ViewAfterRedraw(ByVal WhichDrawing As Drawing, ByVal WhichView As View)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


ViewBeforeRedraw Event

Occurs when [[[when]]]

Syntax

Sub object_ViewBeforeRedraw(ByVal WhichDrawing As Drawing, ByVal WhichView As View)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


VirtualIntersectionPick Event

Occurs when [[[when]]]

Syntax

Sub object_VirtualIntersectionPick(ByVal WhichDrawing As Drawing, ByVal WhichView As View, ByVal Result As PickResult, ByVal PickWasCanceled As Boolean)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

Result Required PickResult. [[[Describe Parameter Here]]]

PickWasCanceled Required Boolean. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


WindowActivate Event

Occurs when [[[when]]]

Syntax

Sub object_WindowActivate(ByVal WhichDrawing As Drawing, ByVal WhichView As View, ByVal WhichWindow As Window)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

WhichWindow Required Window. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


WindowDeactivate Event

Occurs when [[[when]]]

Syntax

Sub object_WindowDeactivate(ByVal WhichDrawing As Drawing, ByVal WhichView As View, ByVal WhichWindow As Window)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

WhichWindow Required Window. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


WindowResize Event

Occurs when [[[when]]]

Syntax

Sub object_WindowResize(ByVal WhichDrawing As Drawing, ByVal WhichView As View, ByVal WhichWindow As Window)

WhichDrawing Required Drawing. [[[Describe Parameter Here]]]

WhichView Required View. [[[Describe Parameter Here]]]

WhichWindow Required Window. [[[Describe Parameter Here]]]

Remarks

[[[Insert Remarks Here]]]


Application Object

[[[describe object and uses here]]]


Block Object

Drawings collection (Drawing object)
Blocks collection (Block object)
Graphics collection (Graphic object)

[[[describe object and uses here]]]


Blocks Collection Object

Drawings collection (Drawing object)
Blocks collection (Block object)
Graphics collection (Graphic object)

[[[describe object and uses here]]]


BoundingBox Object

A BoundingBox is an object that holds the minimum and maximum X, Y, and Z coordinates for an axis-aligned box in three dimensional space. BoundingBox objects are usually obtained by calling the CalcBoundingBox method on a Graphic object or on one of the collections of Graphic objects.


BrushPattern Object

Drawings collection (Drawing object)
BrushStyles collection (BrushStyle object)
BrushPatterns collection (BrushPattern object)

[[[describe object and uses here]]]


BrushPatterns Collection Object

Drawings collection (Drawing object)
BrushStyles collection (BrushStyle object)
BrushPatterns collection (BrushPattern object)

[[[describe object and uses here]]]


BrushStyle Object

Drawings collection (Drawing object)
BrushStyles collection (BrushStyle object)
BrushPatterns collection (BrushPattern object)
Graphics collection (Graphic object)

[[[describe object and uses here]]]


BrushStyles Collection Object

Drawings collection (Drawing object)
BrushStyles collection (BrushStyle object)
BrushPatterns collection (BrushPattern object)

[[[describe object and uses here]]]


Camera Object

Drawings collection (Drawing object)
Views collection (View object)

[[[describe object and uses here]]]


Drawing Object

Drawings collection (Drawing object)

[[[describe object and uses here]]]


Drawings Collection Object

Drawings collection (Drawing object)

[[[describe object and uses here]]]


Filter Object

Filters collection (Filter object)

[[[describe object and uses here]]]


Filters Collection Object

Filters collection (Filter object)

[[[describe object and uses here]]]


Global Object

The Global object is used as a shortcut for many of the methods and properties of the Application object. If Visual Basic for Applications cannot find the name of a function, operator or statement in the list of its own built-in names, it will search for a matching property or method signature in the the implied Global object.

For instance, to access the active drawing, the following two code statements are equivalent:

Dim app As New Application
Dim dwg As Drawing

'Using Application object's ActiveDrawing property
Set dwg = app.ActiveDrawing

'Using implied Global object's ActiveDrawing property
Set dwg = ActiveDrawing


Graphic Object

Drawings collection (Drawing object)
Graphics collection (Graphic object)

[[[describe object and uses here]]]


Graphics Collection Object

Drawings collection (Drawing object)
Graphics collection (Graphic object)

[[[describe object and uses here]]]


GraphicSet Collection Object

Drawings collection (Drawing object)
GraphicSets collection (GraphicSet object)

[[[describe object and uses here]]]


GraphicSets Collection Object

Drawings collection (Drawing object)
GraphicSets collection (GraphicSet object)

[[[describe object and uses here]]]


Layer Object

Drawings collection (Drawing object)
Layers collection (Layer object)

[[[describe object and uses here]]]


Layers Collection Object

Layers collection (Layer object)

[[[describe object and uses here]]]


LineStyle Object

Drawings collection (Drawing object)
LineStyles collection (LineStyle object)
Graphics collection (Graphic object)

[[[describe object and uses here]]]


LineStyles Collection Object

Drawings collection (Drawing object)
LineStyles collection (LineStyle object)

[[[describe object and uses here]]]


Macro Object

Drawings collection (Drawing object)
Macros collection (Macro object)

[[[describe object and uses here]]]


Macros Collection Object

Drawings collection (Drawing object)
Macros collection (Macro object)

[[[describe object and uses here]]]


Matrix Object

[[[describe object and uses here]]]


NamedColor Object

NamedColors collection (NamedColor object)

[[[describe object and uses here]]]


NamedColors Collection Object

NamedColors collection (NamedColor object)

[[[describe object and uses here]]]


NamedView Object

Drawings collection (Drawing object)
NamedViews collection (NamedView object)

[[[describe object and uses here]]]


NamedViews Collection Object

Drawings collection (Drawing object)
NamedViews collection (NamedView object)

[[[describe object and uses here]]]


PaperSpace Object

Drawings collection (Drawing object)
PaperSpaces collection (PaperSpace object)
Graphics collection (Graphic object)
Properties collection (Property object)

[[[describe object and uses here]]]


PaperSpaces Collection Object

Drawings collection (Drawing object)
PaperSpaces collection (PaperSpace object)
Graphics collection (Graphic object)
Properties collection (Property object)

[[[describe object and uses here]]]


PickEntry Object

Drawings collection (Drawing object)
Views collection (View object)

[[[describe object and uses here]]]


PickResult Collection Object

Drawings collection (Drawing object)
Views collection (View object)

[[[describe object and uses here]]]


Property Object

Properties collection (Property object)

[[[describe object and uses here]]]


Properties Collection Object

Properties collection (Property object)

[[[describe object and uses here]]]


RegenMethod Object

RegenMethods collection (RegenMethod object)

[[[describe object and uses here]]]


RegenMethods Collection Object

RegenMethods collection (RegenMethod object)

[[[describe object and uses here]]]


Render Object

Renders collection (Render object)

[[[describe object and uses here]]]


Renders Collection Object

Renders collection (Render object)

[[[describe object and uses here]]]


RenderView Object

Drawings collection (Drawing object)
Views collection (View object)

[[[describe object and uses here]]]


Selection Object

Drawings collection (Drawing object)

[[[describe object and uses here]]]


Tie Object

Drawings collection (Drawing object)
TieSets collection (TieSet object)
Ties collection (Tie object)

[[[describe object and uses here]]]


TieMethod Object

TieMethods collection (TieMethod object)

[[[describe object and uses here]]]


TieMethods Collection Object

TieMethods collection (TieMethod object)

[[[describe object and uses here]]]


TieSet Object

Drawings collection (Drawing object)
TieSets collection (TieSet object)
Ties collection (Tie object)

[[[describe object and uses here]]]


TieSets Collection Object

Drawings collection (Drawing object)
TieSets collection (TieSet object)
Ties collection (Tie object)

[[[describe object and uses here]]]


Tool Object

Tools collection (Tool object)

[[[describe object and uses here]]]


Tools Collection Object

Tools collection (Tool object)

[[[describe object and uses here]]]


UndoRecord Object

Drawings collection (Drawing object)

[[[describe object and uses here]]]


Vertex Object

Drawings collection (Drawing object)
Graphics collection (Graphic object)
Vertices collection (Vertex object)

Represents a vertex. The Vertex object is a member of the Vertices collection. The Vertices collection contains all the Vertex objects in a graphic.

The Vertex object can also be used outside of the Vertices collection to hold three dimensional coordinate information. For example, the three dimensional size of graphic objects is returned in a BoundingBox object, which contains two Vertex objects that hold the minimum and maximum coordinates of the object.

Using the Vertex Object

Use Vertices(index), where index is the vertex index number, to return a single Vertex object. The following example determines whether the first vertex in a graphic can be edited using the user interface.

Dim gr As Graphic
Dim editable As Boolean
Set gr = ActiveDrawing.Selection(0)
editable = gr.Vertices(0).Editable

The following example prints the bounding box coordintate information for a graphic to the Visual Basic for Applications Immediate Window. Min and Max are the Vertex objects contained in the bounding box.

Dim gr As Graphic
Dim bbox As BoundingBox
Set gr = ActiveDrawing.Selection(0)
Set bbox = gr.CalcBoundingBox
Debug.Print "min: " & bbox.Min.X & ", " & bbox.Min.Y & ", " & bbox.Min.Z
Debug.Print "max: " & bbox.Max.X & ", " & bbox.Max.Y & ", " & bbox.Max.Z


Vertices Collection Object

Drawings collection (Drawing object)
Graphics collection (Graphic object)
Vertices collection (Vertex object)

[[[describe object and uses here]]]


View Object

Drawings collection (Drawing object)
Views collection (View object)

[[[describe object and uses here]]]


Views Collection Object

Drawings collection (Drawing object)
Views collection (View object)

[[[describe object and uses here]]]


Activate Method

Activates the object.

Syntax

expresssion.Activate

expression Required. An expression that returns a Tool object.


Add Method

Creates and adds a new Graphic object to the collection.

Syntax 1

expresssion.Add(GraphicType, RegenMethod, Inherit, Style, Before, After)

expression Required. An expression that returns a Layer object.

GraphicType Required Variant. The type of the Graphic object.

RegenMethod Optional Variant. A RegenMethod object or index.

Inherit Optional Variant. True if the new Graphic object will inherit the properties of its parent.

Style Optional Variant. Not used in current implementation.

Before Optional Variant. The Graphic object or index that will follow the added Graphic object.

After Optional Variant. The Graphic object or index that will precede the added Graphic object.

Return Value

Graphic. The newly created Graphic object.

Syntax 2

expresssion.Add(Name, Temporary)

expression Required. An expression that returns a GraphicSets object.

Name Required Variant. The name of the GraphicSet object.

Temporary Optional Variant. True if the new GraphicSet object deletes on release.

Return Value

GraphicSet. The new GraphicSet object.

Syntax 3

expresssion.Add(Name, Visible, Editable, Frozen, Color, LineStyle, BrushStyle, GraphicStyle, ZOrder)

expression Required. An expression that returns a Layers object.

Name Required String. The name of the Layer object.

Visible Required Variant. True if Graphic objects on the Layer object are visible.

Editable Optional Variant. True if Graphic objects on the Layer object can be edited.

Frozen Optional Variant. True if Graphic objects on the Layer object cannot be edited or selected.

Color Optional Variant. The color of the Layer object.

LineStyle Optional Variant. The LineStyle object name or object for the Layer object.

BrushStyle Optional Variant. The BrushStyle object name or object for the Layer object.

GraphicStyle Optional Variant. The Style object name or object for the Layer object.

ZOrder Optional Variant. The z order for the Layer object.

Return Value

Layer. The newly created Layer object.

Syntax 4

expresssion.Add(Name, Dashes, Description)

expression Required. An expression that returns a LineStyles object.

Name Required String. The name of the LineStyle object.

Dashes Required Variant. An array of dash lengths.

Description Required Variant. A description string.

Return Value

LineStyle. The newly created LineStyle object.

Syntax 5

expresssion.Add(Name, Path)

expression Required. An expression that returns a Macros object.

Name Required String. The name of the new Macro object.

Path Required String. Description missing

Return Value

Macro. The newly created NamedView object.

Syntax 6

expresssion.Add(Name, Color)

expression Required. An expression that returns a NamedColors object.

Name Required String. The name of the NamedColor object.

Color Required Long. The RGB value of the NamedColor object.

Return Value

NamedColor. The newly created NamedColor object.

Syntax 7

expresssion.Add(Name, XMin, YMin, XMax, YMax)

expression Required. An expression that returns a NamedViews object.

Name Required String. The name of the new NamedView object.

XMin Required Double. The x coordinate of one corner (in viewport coordinates).

YMin Required Double. The y coordinate of one corner (in viewport coordinates).

XMax Required Double. The x coordinate of the other corner (in viewport coordinates).

YMax Required Double. The y coordinate of the other corner (in viewport coordinates).

Return Value

NamedView. The newly created NamedView object.

Syntax 8

expresssion.Add(X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable, Calculated, Before, After)

expression Required. An expression that returns a Vertices object.

X Required Variant. X coordinate of the vertex.

Y Optional Variant. Y coordinate of the vertex.

Z Optional Variant. Z coordinate of the vertex.

PenDown Optional Variant. True if the segment to this vertex is drawn.

Selectable Optional Variant. True if the vertex can be selected.

Snappable Optional Variant. True if the vertex can be snapped to.

Editable Optional Variant. True if the vertex can be edited.

Linkable Optional Variant. True if the vertex can be linked to.

Calculated Optional Variant. True if the Vertex object is recalculated by the RegenMethod.

Before Optional Variant. Vertex object or index to follow this one.

After Optional Variant. Vertex object or index to precede this one.

Return Value

Vertex. The newly created Vertex object.

Syntax 9

expresssion.Add(HWND, hDC)

expression Required. An expression that returns a Views object.

HWND Required Variant. A window handle to attach to the View object.

hDC Optional Variant. A DC to attach to the View object.

Return Value

View. The newly created View object.

Syntax 10

expresssion.Add(Template)

expression Required. An expression that returns a Drawings object.

Template Required Variant. A drawing template name.

Return Value

Drawing. The newly created Drawing object.

Syntax 11

expresssion.Add(Name, Graphic, XRef, YRef, ZRef, CopyGraphic, InsertBlock, Insert)

expression Required. An expression that returns a Blocks object.

Name Required String. The name of the new Block object.

Graphic Required Graphic. The Graphic object that the Block object will contain.

XRef Required Variant. X coordinate of the block reference point.

YRef Optional Variant. Y coordinate of the block reference point.

ZRef Optional Variant. Z coordinate of the block reference point.

CopyGraphic Optional Variant. True to make the block using copies of the Graphic object.

InsertBlock Optional Variant. True to insert the new block in the Drawing object.

Insert Optional Variant. The Insert Graphic object if InsertBlock was true

Return Value

Block. The newly created Block object.

Syntax 12

expresssion.Add(Name, Value, ReadOnly, ID)

expression Required. An expression that returns a Properties object.

Name Required String. Name of the new Property object.

Value Required Variant. The value of the new Property object, by reference.

ReadOnly Optional Variant. True if the new Property object's value cannot be modified.

ID Optional Variant. Internal ID.

Return Value

Property. The newly created Property object.


AddArcCenterAndPoint Method

Creates and adds an arc to the collection. @see TCADAPI TCWArcCenterAndPoint function

Syntax

expresssion.AddArcCenterAndPoint(X0, Y0, Z0, X1, Y1, Z1, StartAngle, EndAngle)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of arc's center point.

Y0 Required Double. Y coordinate of arc's center point.

Z0 Required Double. Z coordinate of arc's center point.

X1 Required Double. X coordinate of arc's radius point.

Y1 Required Double. Y coordinate of arc's radius point.

Z1 Required Double. Z coordinate of arc's radius point.

StartAngle Required Double. Starting angle in radians.

EndAngle Required Double. Ending angle in radians.

Return Value

Graphic. The newly created Graphic object.


AddArcDoublePoint Method

Creates and adds an arc to the collection. @see TCADAPI TCWArcDoublePoint function

Syntax

expresssion.AddArcDoublePoint(X0, Y0, Z0, X1, Y1, Z1, StartAngle, EndAngle)

expression Required. An expression that returns a Layer object.

X0 Required Double. X coordinate of first endpoint.

Y0 Required Double. Y coordinate of first endpoint.

Z0 Required Double. Z coordinate of first endpoint.

X1 Required Double. X coordinate of second endpoint.

Y1 Required Double. Y coordinate of second endpont.

Z1 Required Double. Z coordinate of second endpoint.

StartAngle Required Double. Starting angle in radians.

EndAngle Required Double. Ending angle in radians.

Return Value

Graphic. The newly created Graphic object.


AddArcElliptical Method

Creates and adds an elliptical arc to the collection. @see TCADAPI TCWArcElliptical function

Syntax

expresssion.AddArcElliptical(X0, Y0, Z0, X1, Y1, Z1, StartAngle, EndAngle)

expression Required. An expression that returns a Layer object.

X0 Required Double. X coordinate of bounding rectangle's upper left corner.

Y0 Required Double. Y coordinate of bounding rectangle's upper left corner.

Z0 Required Double. Z coordinate of bounding rectangle's upper left corner.

X1 Required Double. X coordinate of bounding rectangle's lower right corner.

Y1 Required Double. Y coordinate of bounding rectangle's lower right corner.

Z1 Required Double. Z coordinate of bounding rectangle's lower right corner.

StartAngle Required Double. Starting angle in radians.

EndAngle Required Double. Ending angle in radians.

Return Value

Graphic. The newly created Graphic object.


AddArcEllipticalFixedRatio Method

Creates and adds an elliptical arc to the collection. @see TCADAPI TCWArcEllipticalFixedRatio function

Syntax

expresssion.AddArcEllipticalFixedRatio(X0, Y0, Z0, X1, Y1, Z1, XToYRatio, StartAngle, EndAngle)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of ellipse's center point.

Y0 Required Double. Y coordinate of ellipse's center point.

Z0 Required Double. Z coordinate of ellipse's center point.

X1 Required Double. X coordinate of radius in Y direction.

Y1 Required Double. Y coordinate of radius in Y direction.

Z1 Required Double. Z coordinate of radius in Y direction.

XToYRatio Required Double. Ratio of Rx to Ry.

StartAngle Required Double. Starting angle in radians.

EndAngle Required Double. Ending angle in radians.

Return Value

Graphic. The newly created Graphic object.


AddArcRotatedElliptical Method

Creates and adds an elliptical arc to the collection. @see TCADAPI TCWArcRotatedElliptical function

Syntax

expresssion.AddArcRotatedElliptical(X0, Y0, Z0, X1, Y1, Z1, X2, Y2, Z2, StartAngle, EndAngle)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of elliptical arc's center point.

Y0 Required Double. Y coordinate of elliptical arc's center point.

Z0 Required Double. Z coordinate of elliptical arc's center point.

X1 Required Double. X coordinate of major axis radius point.

Y1 Required Double. Y coordinate of major axis radius point.

Z1 Required Double. Z coordinate of major axis radius point.

X2 Required Double. X coordinate of minor axis radius point.

Y2 Required Double. Y coordinate of minor axis radius point.

Z2 Required Double. Z coordinate of minor axis radius point.

StartAngle Required Double. Starting angle in radians.

EndAngle Required Double. Ending angle in radians.

Return Value

Graphic. The newly created Graphic object.


AddArcTriplePoint Method

Creates and adds an arc to the collection. @see TCADAPI TCWArcTriplePoint function

Syntax

expresssion.AddArcTriplePoint(X0, Y0, Z0, X1, Y1, Z1, X2, Y2, Z2)

expression Required. An expression that returns a Layer object.

X0 Required Double. X coordinate of starting point.

Y0 Required Double. Y coordinate of starting point.

Z0 Required Double. Z coordinate of starting point.

X1 Required Double. X coordinate of point on perimeter.

Y1 Required Double. Y coordinate of point on perimeter.

Z1 Required Double. Z coordinate of point on perimeter.

X2 Required Double. X coordinate of ending point.

Y2 Required Double. Y coordinate of ending point.

Z2 Required Double. Z coordinate of ending point.

Return Value

Graphic. The newly created Graphic object.


AddAttributeDefinition Method

HRESULT XRefPath [out, retval] BSTR prop // The path to the referencing file . ); / Creates and adds an attribute definition Graphic object to the collection.

Syntax

expresssion.AddAttributeDefinition(Tag, X0, Y0, Z0, Height, Angle, Width, Offset, Justification, AttFlags, Default, Prompt)

expression Required. An expression that returns a Block object.

Tag Required String. The text string for the attribute definition tag.

X0 Required Double. X coordinate of attdef's starting point.

Y0 Required Double. Y coordinate of attdef's starting point.

Z0 Required Double. Z coordinate of attdef's starting point.

Height Required Double. Height of attdef object.

Angle Required Variant. Rotation angle of attdef in radians.

Width Optional Variant. Width of attdef object.

Offset Optional Variant. An ImsiTextOffset.

Justification Optional Variant. An ImsiTextJustification.

AttFlags Optional Variant. ImsiAttFlag values.

Default Optional Variant. Default value of attribute.

Prompt Optional Variant. Prompt for attribute.

Return Value

Graphic. The newly created Graphic object.


AddBlockInsertion Method

Adds a block insertion to the collection. @see TCADAPI TCWBlockInsert function

Syntax

expresssion.AddBlockInsertion(Block, X0, Y0, Z0, XScale, YScale, ZScale, Angle)

expression Required. An expression that returns a Graphics object.

Block Required Variant. BlockObj or index of the block.

X0 Required Variant. X coordinate of the block insertion point.

Y0 Optional Variant. Y coordinate of the block insertion point.

Z0 Optional Variant. Z coordinate of the block insertion point.

XScale Optional Variant. X scale factor.

YScale Optional Variant. Y scale factor.

ZScale Optional Variant. Z scale factor.

Angle Optional Variant. Rotation angle of block insertion in radians.

Return Value

Graphic. The newly created Graphic object.


AddCircle Method

Creates and adds a circle marker to the collection. @see TCADAPI TCWCircle function

Syntax

expresssion.AddCircle(X0, Y0, Z0)

expression Required. An expression that returns a Layer object.

X0 Required Double. X coordinate of the point.

Y0 Required Double. Y coordinate of the point.

Z0 Required Double. Z coordinate of the point.

Return Value

Graphic. The newly created Graphic object.


AddCircleCenterAndPoint Method

Creates and adds a circle to the collection. @see TCADAPI TCWCircleCenterAndPoint function

Syntax

expresssion.AddCircleCenterAndPoint(X0, Y0, Z0, X1, Y1, Z1)

expression Required. An expression that returns a Layer object.

X0 Required Double. X coordinate of the center point.

Y0 Required Double. Y coordinate of the center point.

Z0 Required Double. Z coordinate of the cneter point.

X1 Required Double. X coordinate of the radius point.

Y1 Required Double. Y coordinate of the radius point.

Z1 Required Double. Z coordinate of the radius point.

Return Value

Graphic. The newly created Graphic object.


AddCircleDoublePoint Method

Creates and adds a circle to the collection. @see TCADAPI TCWCircleDoublePoint function

Syntax

expresssion.AddCircleDoublePoint(X0, Y0, Z0, X1, Y1, Z1)

expression Required. An expression that returns a Layer object.

X0 Required Double. X coordinate of the first point.

Y0 Required Double. Y coordinate of the first point.

Z0 Required Double. Z coordinate of the first point.

X1 Required Double. X coordinate of the second point.

Y1 Required Double. Y coordinate of the second point.

Z1 Required Double. Z coordinate of the second point.

Return Value

Graphic. The newly created Graphic object.


AddCircleTriplePoint Method

Creates and adds a circle to the collection. @see TCADAPI TCWCircleTriplePoint function

Syntax

expresssion.AddCircleTriplePoint(X0, Y0, Z0, X1, Y1, Z1, X2, Y2, Z2)

expression Required. An expression that returns a Layer object.

X0 Required Double. X coordinate of the first point.

Y0 Required Double. Y coordinate of the first point.

Z0 Required Double. Z coordinate of the first point.

X1 Required Double. X coordinate of the second point.

Y1 Required Double. Y coordinate of the second point.

Z1 Required Double. Z coordinate of the second point.

X2 Required Double. X coordinate of the third point.

Y2 Required Double. Y coordinate of the third point.

Z2 Required Double. Z coordinate of the third point.

Return Value

Graphic. The newly created Graphic object.


AddClose Method

Creates a new Vertex object and closes the collection's Graphic object.

Syntax

expresssion.AddClose(PenDown, Selectable, Snappable, Editable, Linkable, Calculated)

expression Required. An expression that returns a Vertices object.

PenDown Required Variant. True if the segment to this vertex is drawn.

Selectable Optional Variant. True if the vertex can be selected.

Snappable Optional Variant. True if the vertex can be snapped to.

Editable Optional Variant. True if the vertex can be edited.

Linkable Optional Variant. True if the vertex can be linked to.

Calculated Optional Variant. True if the Vertex object is recalculated by the RegenMethod.

Return Value

Vertex. The newly created Vertex object.


AddConstructionAngularLine Method

Creates and adds a construction line to the collection. @see TCADAPI TCWConstructionAngularLine function

Syntax

expresssion.AddConstructionAngularLine(X0, Y0, Z0, X1, Y1, Z1)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of the first point on line.

Y0 Required Double. Y coordinate of the first point on line.

Z0 Required Double. Z coordinate of the first point on line.

X1 Required Double. X coordinate of the second point on line.

Y1 Required Double. Y coordinate of the second point on line.

Z1 Required Double. Z coordinate of the second point on line.

Return Value

Graphic. The newly created Graphic object.


AddConstructionCenterAndPointCircle Method

Creates and adds a construction circle to the collection. @see TCADAPI TCWConstructionCenterAndPointCircle function

Syntax

expresssion.AddConstructionCenterAndPointCircle(X0, Y0, Z0, X1, Y1, Z1)

expression Required. An expression that returns a Layer object.

X0 Required Double. X coordinate of the center point.

Y0 Required Double. Y coordinate of the center point.

Z0 Required Double. Z coordinate of the center point.

X1 Required Double. X coordinate of the perimeter point.

Y1 Required Double. Y coordinate of the perimeter point.

Z1 Required Double. Z coordinate of the perimeter point.

Return Value

Graphic. The newly created Graphic object.


AddConstructionDoublePointCircle Method

Creates and adds a construction circle to the collection. @see TCADAPI TCWConstructionDoublePointCircle function

Syntax

expresssion.AddConstructionDoublePointCircle(X0, Y0, Z0, X1, Y1, Z1)

expression Required. An expression that returns a Layer object.

X0 Required Double. X coordinate of the first point.

Y0 Required Double. Y coordinate of the first point.

Z0 Required Double. Z coordinate of the first point.

X1 Required Double. X coordinate of the second point.

Y1 Required Double. Y coordinate of the second point.

Z1 Required Double. Z coordinate of the second point.

Return Value

Graphic. The newly created Graphic object.


AddConstructionHorizontalLine Method

Creates and adds a construction line to the collection. @see TCADAPI TCWConstructionHorizontalLine function

Syntax

expresssion.AddConstructionHorizontalLine(X0, Y0, Z0)

expression Required. An expression that returns a Layer object.

X0 Required Double. X coordinate of the line.

Y0 Required Double. Y coordinate of the line.

Z0 Required Double. Z coordinate of the line.

Return Value

Graphic. The newly created Graphic object.


AddConstructionTriplePointCircle Method

Creates and adds a construction circle to the collection. @see TCADAPI TCWConstructionTriplePointCircle function

Syntax

expresssion.AddConstructionTriplePointCircle(X0, Y0, Z0, X1, Y1, Z1, X2, Y2, Z2)

expression Required. An expression that returns a Layer object.

X0 Required Double. X coordinate of the first point.

Y0 Required Double. Y coordinate of the first point.

Z0 Required Double. Z coordinate of the first point.

X1 Required Double. X coordinate of the second point.

Y1 Required Double. Y coordinate of the second point.

Z1 Required Double. Z coordinate of the second point.

X2 Required Double. X coordinate of the third point.

Y2 Required Double. Y coordinate of the third point.

Z2 Required Double. Z coordinate of the third point.

Return Value

Graphic. The newly created Graphic object.


AddConstructionVerticalLine Method

Creates and adds a construction line to the collection. @see TCADAPI TCWConstructionVerticalLine function

Syntax

expresssion.AddConstructionVerticalLine(X0, Y0, Z0)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of the line.

Y0 Required Double. Y coordinate of the line.

Z0 Required Double. Z coordinate of the line.

Return Value

Graphic. The newly created Graphic object.


AddCross Method

Creates and adds a cross marker to the collection. @see TCADAPI TCWCross function

Syntax

expresssion.AddCross(X0, Y0, Z0)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of the point.

Y0 Required Double. Y coordinate of the point.

Z0 Required Double. Z coordinate of the point.

Return Value

Graphic. The newly created Graphic object.


AddCurveBezier Method

Creates and adds a bezier curve to the collection. The returned Graphic object contains only a beginning vertex. The user must use subsequent Graphic.NextPoint calls to add segments to the Graphic object, and a Graphic.Finish call to complete the Graphic object. @see TCADAPI TCWCurveBezier function

Syntax

expresssion.AddCurveBezier(X0, Y0, Z0)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of the first endpoint.

Y0 Required Double. Y coordinate of the first endpoint.

Z0 Required Double. Z coordinate of the first endpoint.

Return Value

Graphic. The newly created Graphic object.


AddCurveSpline Method

Creates and adds a cubic spline curve to the collection. The returned Graphic object contains only a beginning vertex. The user must use subsequent Graphic.NextPoint calls to add segments to the Graphic object, and a Graphic.Finish call to complete the Graphic object. @see TCADAPI TCWCurveSpline function

Syntax

expresssion.AddCurveSpline(X0, Y0, Z0)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of the first endpoint.

Y0 Required Double. Y coordinate of the first endpoint.

Z0 Required Double. Z coordinate of the first endpoint.

Return Value

Graphic. The newly created Graphic object.


AddDot Method

Creates and adds a dot marker to the collection. @see TCADAPI TCWDot function

Syntax

expresssion.AddDot(X0, Y0, Z0)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of the point.

Y0 Required Double. Y coordinate of the point.

Z0 Required Double. Z coordinate of the point.

Return Value

Graphic. The newly created Graphic object.


AddEllipse Method

Creates and adds a ellipse to the collection. @see TCADAPI TCWEllipse function

Syntax

expresssion.AddEllipse(X0, Y0, Z0, X1, Y1, Z1)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of bounding rectangle's upper left corner.

Y0 Required Double. Y coordinate of bounding rectangle's upper left corner.

Z0 Required Double. Z coordinate of bounding rectangle's upper left corner.

X1 Required Double. X coordinate of bounding rectangle's lower right corner.

Y1 Required Double. Y coordinate of bounding rectangle's lower right corner.

Z1 Required Double. Z coordinate of bounding rectangle's lower right corner.

Return Value

Graphic. The newly created Graphic object.


AddEllipseFixedRatio Method

Creates and adds a ellipse to the collection. @see TCADAPI TCWEllipseFixedRatio function

Syntax

expresssion.AddEllipseFixedRatio(X0, Y0, Z0, X1, Y1, Z1, XToYRatio)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of ellipse's center point.

Y0 Required Double. Y coordinate of ellipse's center point.

Z0 Required Double. Z coordinate of ellipse's center point.

X1 Required Double. X coordinate of radius in Y direction.

Y1 Required Double. Y coordinate of radius in Y direction.

Z1 Required Double. Z coordinate of radius in Y direction.

XToYRatio Required Double. Ratio of Rx to Ry.

Return Value

Graphic. The newly created Graphic object.


AddEllipseRotatedEllipse Method

Creates and adds a ellipse to the collection. @see TCADAPI TCWEllipseRotatedEllipse function

Syntax

expresssion.AddEllipseRotatedEllipse(X0, Y0, Z0, X1, Y1, Z1, X2, Y2, Z2)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of ellipse's center point.

Y0 Required Double. Y coordinate of ellipse's center point.

Z0 Required Double. Z coordinate of ellipse's center point.

X1 Required Double. X coordinate of major axis radius point.

Y1 Required Double. Y coordinate of major axis radius point.

Z1 Required Double. Z coordinate of major axis radius point.

X2 Required Double. X coordinate of minor axis radius point.

Y2 Required Double. Y coordinate of minor axis radius point.

Z2 Required Double. Z coordinate of minor axis radius point.

Return Value

Graphic. The newly created Graphic object.


AddGraphic Method

Adds an existing Graphic object to the collection.

Syntax 1

expresssion.AddGraphic(Graphic, Before, After)

expression Required. An expression that returns a Layer object.

Graphic Required Graphic. The Graphic object to add.

Before Optional Variant. The Graphic object or index that will follow the added Graphic object.

After Optional Variant. The Graphic object or index that will precede the added Graphic object.

Syntax 2

expresssion.AddGraphic(Graphic)

expression Required. An expression that returns an UndoRecord object.

Graphic Required Graphic. The Graphic object to delete when Undo is called.


AddGraphicForModify Method

Adds a purged reference to the Graphic object to the URecObj.

Syntax

expresssion.AddGraphicForModify(Graphic)

expression Required. An expression that returns an UndoRecord object.

Graphic Required Graphic. The Graphic object to restore when Undo is called.


AddHatch Method

Adds a hatch pattern to the collection from the Graphic objects in the collection. @see TCADAPI TCWCreateHatch function

Syntax

expresssion.AddHatch

expression Required. An expression that returns a Graphics object.

Return Value

Graphic. The newly created Graphic object.


AddItem Method

Adds an item to the BrushPattern object.

Syntax

expresssion.AddItem(Dashes, XOrigin, YOrigin, Angle)

expression Required. An expression that returns a BrushPattern object.

Dashes Required Variant. The line style.

XOrigin Required Double. The x coordinate of the pattern's origin.

YOrigin Required Double. The y coordinate of the pattern's origin.

Angle Required Double. The angle of the line in radians.


AddLineIrregularPolygon Method

Creates and adds an irregular polygon to the collection. The returned Graphic object contains only a beginning vertex. The user must use subsequent Graphic.NextPoint calls to add segments to the Graphic object, and a Graphic.Close call to complete the Graphic object. @see TCADAPI TCWLineIrregularPolygon function

Syntax

expresssion.AddLineIrregularPolygon(X0, Y0, Z0)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of first endpoint.

Y0 Required Double. Y coordinate of first endpoint.

Z0 Required Double. Z coordinate of first endpoint.

Return Value

Graphic. The newly created Graphic object.


AddLineMultiline Method

Creates and adds a multiple segment line to the collection. The returned Graphic object contains only a beginning vertex. The user must use subsequent Graphic.NextPoint calls to add segments to the Graphic object, and a Graphic.Finish call to complete the Graphic object. @see TCADAPI TCWLineMultiline function

Syntax

expresssion.AddLineMultiline(X0, Y0, Z0)

expression Required. An expression that returns a Layer object.

X0 Required Double. X coordinate of first endpoint.

Y0 Required Double. Y coordinate of first endpoint.

Z0 Required Double. Z coordinate of first endpoint.

Return Value

Graphic. The newly created Graphic object.


AddLineParallel Method

Creates and adds a single line segment to the collection. @see TCADAPI TCWLineParallel function

Syntax

expresssion.AddLineParallel(ParallelTo, X0, Y0, Z0)

expression Required. An expression that returns a Graphics object.

ParallelTo Required Graphic. Line to make new line parallel to.

X0 Required Double. X coordinate of the new line.

Y0 Required Double. Y coordinate of the new line.

Z0 Required Double. Z coordinate of the new line.

Return Value

Graphic. The newly created Graphic object.


AddLinePerpendicular Method

Creates and adds a single line segment to the collection. @see TCADAPI TCWLinePerpendicular function

Syntax

expresssion.AddLinePerpendicular(PerpTo, X0, Y0, Z0, X1, Y1, Z1)

expression Required. An expression that returns a Graphics object.

PerpTo Required Graphic. Line to make new line perpendicular to.

X0 Required Double. X coordinate of the point on the existing line.

Y0 Required Double. Y coordinate of the point on the existing line.

Z0 Required Double. Z coordinate of the point on the existing line.

X1 Required Double. X coordinate of the second point on the new line.

Y1 Required Double. Y coordinate of the second point on the new line.

Z1 Required Double. Z coordinate of the second point on the new line.

Return Value

Graphic. The newly created Graphic object.


AddLinePolygon Method

Creates and adds a regular polygon to the collection. @see TCADAPI TCWLinePolygon function

Syntax

expresssion.AddLinePolygon(X0, Y0, Z0, X1, Y1, Z1, nsides)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of the center point.

Y0 Required Double. Y coordinate of the center point.

Z0 Required Double. Z coordinate of the center point.

X1 Required Double. X coordinate of the corner point.

Y1 Required Double. Y coordinate of the corner point.

Z1 Required Double. Z coordinate of the corner point.

nsides Required Long. number of sides.

Return Value

Graphic. The newly created Graphic object.


AddLineRectangle Method

Creates and adds a rectangle to the collection. @see TCADAPI TCWLineRectangle function

Syntax

expresssion.AddLineRectangle(X0, Y0, Z0, X1, Y1, Z1)

expression Required. An expression that returns a Layer object.

X0 Required Double. X coordinate of the upper left corner.

Y0 Required Double. Y coordinate of the upper left corner.

Z0 Required Double. Z coordinate of the upper left corner.

X1 Required Double. X coordinate of the lower right corner.

Y1 Required Double. Y coorindate of the lower right corner.

Z1 Required Double. Z coorindate of the lower right corner.

Return Value

Graphic. The newly created Graphic object.


AddLineRotatedRectangle Method

Creates and adds a rotated rectangle to the collection. @see TCADAPI TCWLineRotatedRectangle function

Syntax

expresssion.AddLineRotatedRectangle(X0, Y0, Z0, X1, Y1, Z1, Height)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of the upper left corner.

Y0 Required Double. Y coordinate of the upper left corner.

Z0 Required Double. Z coordinate of the upper left corner.

X1 Required Double. X coordinate of the lower right corner.

Y1 Required Double. Y coorindate of the lower right corner.

Z1 Required Double. Z coorindate of the lower right corner.

Height Required Double. Height of the rectangle.

Return Value

Graphic. The newly created Graphic object.


AddLineSingle Method

Creates and adds a single line segment to the collection. @see TCADAPI TCWLineSingle function

Syntax

expresssion.AddLineSingle(X0, Y0, Z0, X1, Y1, Z1)

expression Required. An expression that returns a Layer object.

X0 Required Double. X coordinate of the first endpoint.

Y0 Required Double. Y coordinate of the first endpoint.

Z0 Required Double. Z coordinate of the first endpoint.

X1 Required Double. X coordinate of the second endpoint.

Y1 Required Double. Y coordinate of the second endpoint.

Z1 Required Double. Z coordinate of the second endpoint.

Return Value

Graphic. The newly created Graphic object.


AddPolylines Method

Creates and adds a bunch of polylines to the collection. The returned Graphics object contains a set with freshly created polygons. The user can set properties, etc.

Syntax

expresssion.AddPolylines(NumberOfPolylines, Coords, Closed)

expression Required. An expression that returns a Graphics object.

NumberOfPolylines Required Long. number of polylines to create

Coords Required Variant. SafeArray of triplets of coordinates.

Closed Required Boolean. whether each polyline is closed

Return Value

GraphicSet. The newly created set of Graphic objects.


AddPolys Method

Creates and adds a group of polylines or polygons to the collection.

Syntax

expresssion.AddPolys(Type, Coords)

expression Required. An expression that returns a Graphics object.

Type Required msiPolyType. Type of poly(s) to be added.

Coords Required Variant. Array of (X, Y, Z) poly coordinates.

Return Value

GraphicSet. The newly created Graphic objects.


AddSquare Method

Creates and adds a square marker to the collection. @see TCADAPI TCWSquare function

Syntax

expresssion.AddSquare(X0, Y0, Z0)

expression Required. An expression that returns a Graphics object.

X0 Required Double. X coordinate of the point.

Y0 Required Double. Y coordinate of the point.

Z0 Required Double. Z coordinate of the point.

Return Value

Graphic. The newly created Graphic object.


AddStar Method

Creates and adds a star to the collection. @see TCADAPI TCWStar function

Syntax

expresssion.AddStar(X0, Y0, Z0)

expression Required. An expression that returns a Layer object.

X0 Required Double. X coordinate of the point.

Y0 Required Double. Y coordinate of the point.

Z0 Required Double. Z coordinate of the point.

Return Value

Graphic. The newly created Graphic object.


AddText Method

Creates and adds a text Graphic object to the collection. @see TCADAPI TCWText function

Syntax

expresssion.AddText(Text, X0, Y0, Z0, Height, Angle, Width, Offset, Justification)

expression Required. An expression that returns a Layer object.

Text Required String. The text string.

X0 Required Double. X coordinate of text's starting point.

Y0 Required Double. Y coordinate of text's starting point.

Z0 Required Double. Z coordinate of text's starting point.

Height Required Double. Height of text object.

Angle Required Variant. Rotation angle of text in radians.

Width Optional Variant. Width of text object.

Offset Optional Variant. An ImsiTextOffset.

Justification Optional Variant. An ImsiTextJustification.

Return Value

Graphic. The newly created Graphic object.


AddTie Method

Add Tie to TieSet

Syntax

expresssion.AddTie(pvarTM, dblPriority, pvarData)

expression Required. An expression that returns a TieSet object.

pvarTM Required Variant. Description missing

dblPriority Required Double. Description missing

pvarData Required Variant. Description missing

Return Value

Tie. Description missing


AddUndoRecord Method

Opens a new URecObj in the Drawing object. Use UndoRecord.AddGraphic, etc. to add graphics to the record. Use UndoRecord.Close to close the record and add it to the Undo list. @see TCADAPI TCWUndoRecordStart function

Syntax

expresssion.AddUndoRecord(MenuText)

expression Required. An expression that returns a Drawing object.

MenuText Required String. The prompt to appear in the Undo list.

Return Value

UndoRecord. The new URecObj.


AddVertex Method

Adds an existing Vertex object to the collection.

Syntax

expresssion.AddVertex(Vertex, Before, After)

expression Required. An expression that returns a Vertices object.

Vertex Required Vertex. The Vertex object to be added.

Before Optional Variant. Vertex object or index to follow this one.

After Optional Variant. Vertex object or index to precede this one.


AddXRef Method

Adds a new Block object to the collection.

Syntax

expresssion.AddXRef(Name, Path, XRef, YRef, ZRef)

expression Required. An expression that returns a Blocks object.

Name Required String. The name of the new Block object.

Path Required String. path to the eXternal Reference file

XRef Required Variant. X coordinate of the block reference point.

YRef Optional Variant. Y coordinate of the block reference point.

ZRef Optional Variant. Z coordinate of the block reference point.

Return Value

Block. The newly created Block object.


ArcSet Method

Set the center, radius, and other arc parameters.

Syntax

expresssion.ArcSet(XCenter, YCenter, ZCenter, MajorAxis, MinorAxis, StartAngle, EndAngle, RotationAngle)

expression Required. An expression that returns a Graphic object.

XCenter Optional Variant. X coordinate of arc center point.

YCenter Optional Variant. Y coordinate of arc center point.

ZCenter Optional Variant. Z coordinate of arc center point.

MajorAxis Optional Variant. Length of major axis.

MinorAxis Optional Variant. Length of minor axis.

StartAngle Optional Variant. Starting angle in radians.

EndAngle Optional Variant. Ending angle in radians.

RotationAngle Optional Variant. Rotation angle of major axis in radians.


BeginRender Method

Description missing

Syntax

expresssion.BeginRender(WhichRender)

expression Required. An expression that returns a RenderView object.

WhichRender Required Integer. Description missing


BringToFront Method

Brings the Graphic object to the front. @see TCADAPI TCWBringToFront function.

Syntax

expresssion.BringToFront

expression Required. An expression that returns a Graphic object.


CalcBoundingBox Method

Returns the Graphic object's bounding box.

Syntax

expresssion.CalcBoundingBox(Transform)

expression Required. An expression that returns a Graphic object.

Transform Required Variant. A transformation Matrix object.

Return Value

BoundingBox. The BoundingBox object.


CameraSetSpaceParameters Method

Set All camera vectors : Pos, Look, Up.

Syntax

expresssion.CameraSetSpaceParameters(pvPos, pvLook, pvU)

expression Required. An expression that returns a Camera object.

pvPos Required Vertex. Description missing

pvLook Required Vertex. Description missing

pvU Required Vertex. Description missing


Clear Method

Deletes the collection's Vertex objects.

Syntax

expresssion.Clear(Types)

expression Required. An expression that returns a Vertices object.

Types Optional Variant. If supplied, the types of Vertex objects to delete.


Close Method

Closes the URecObj and adds it to the Drawing object's Undo stack. TCADAPI UndoRecordEnd function.

Syntax 1

expresssion.Close

expression Required. An expression that returns an UndoRecord object.

Syntax 2

expresssion.Close(SaveChanges, Filename, Filter)

expression Required. An expression that returns a Drawing object.

SaveChanges Optional Variant. True to save changes.

Filename Optional Variant. Alternate file name to save as.

Filter Optional Variant. Name or index of preferred filter.


CloseBitmapBitsDC Method

Description missing

Syntax

expresssion.CloseBitmapBitsDC

expression Required. An expression that returns a View object.

Return Value

Variant. Description missing


CloseBitmapDC Method

Closes the bitmap DC, and returns a bitmap handle.

Syntax

expresssion.CloseBitmapDC

expression Required. An expression that returns a View object.

Return Value

Long. The bitmap handle.


CloseBitmapPictDC Method

Description missing

Syntax

expresssion.CloseBitmapPictDC

expression Required. An expression that returns a View object.

Return Value

Object. Description missing


CloseMetafileBitsDC Method

Description missing

Syntax

expresssion.CloseMetafileBitsDC

expression Required. An expression that returns a View object.

Return Value

Variant. Description missing


CloseMetafileDC Method

Closes the metafile DC, and returns a metafile handle.

Syntax

expresssion.CloseMetafileDC

expression Required. An expression that returns a View object.

Return Value

Long. The metafile handle.


CloseMetafilePictDC Method

Description missing

Syntax

expresssion.CloseMetafilePictDC

expression Required. An expression that returns a View object.

Return Value

Object. Description missing


ConnectEvents Method

Connects an ApplicationEvents object sink to TurboCAD. Set the mask parameter to only receive a subset of the full event set.

Syntax

expresssion.ConnectEvents(EventSink, EventMask)

expression Required. An expression that returns an Application object.

EventSink Required Object. Object that will receive events.

EventMask Required Variant. Mask bits or'ed together (see ImsiEventMask).

Return Value

Long. ID to be used in DisconnectEvents method.


CreateBlock Method

Creates a block in the Drawing object from the Graphic objects in the collection. @see TCADAPI TCWBlockCreate function

Syntax

expresssion.CreateBlock(Name, XRef, YRef, ZRef, CopyGraphics, InsertBlock, Insert)

expression Required. An expression that returns a Graphics object.

Name Required String. Name for the new block.

XRef Required Variant. X coordinate of the block reference point.

YRef Optional Variant. Y coordinate of the block reference point.

ZRef Optional Variant. Z coordinate of the block reference point.

CopyGraphics Optional Variant. True to make the group using copies of the Graphic objects in the Graphics collection.

InsertBlock Optional Variant. True to insert the new block in the Drawing object.

Insert Optional Variant. The Insert Graphic object if InsertBlock was true

Return Value

Block. The newly created block.


CreateDragOutline Method

Generates a bounding polygon array to use in drag operations. @see View::DragOutline

Syntax

expresssion.CreateDragOutline(Coords)

expression Required. An expression that returns a Graphics object.

Coords Required Variant. Array of (X, Y, Z) polygon coordinates.


Delete Method

Deletes the object.

Syntax

expresssion.Delete

expression Required. An expression that returns a Macro object.


DeleteGraphic Method

Deletes the Graphic object, adding a purged reference to the URecObj.

Syntax

expresssion.DeleteGraphic(Graphic)

expression Required. An expression that returns an UndoRecord object.

Graphic Required Graphic. The Graphic object to add when Undo is called.


DeleteGraphics Method

Deletes the Graphics collection, adding a purged references to the URecObj.

Syntax

expresssion.DeleteGraphics(pGrs, pvarFlags)

expression Required. An expression that returns an UndoRecord object.

pGrs Required Graphics. The Graphics collection to add when Undo is called.

pvarFlags Optional Variant. Description missing


DirToNearestFace Method

Finds the side of a BoundingBox closest to a given location.

Syntax

expresssion.DirToNearestFace(Vertex, IgnoreZAxis, OtherVertex)

expression Required. An expression that returns a BoundingBox object.

Vertex Required Vertex. The location to be tested.

IgnoreZAxis Required Boolean. True if testing is only to be done on X and Y axes of the BoundingBox.

OtherVertex Optional Vertex. Ignored; reserved for future use.

Return Value

ImsiDirection. The side of the BoundingBox closest to the given location.


DisconnectEvents Method

Disconnects an ApplicationEvents object sink.

Syntax

expresssion.DisconnectEvents(ConnectionID)

expression Required. An expression that returns an Application object.

ConnectionID Required Long. ID returned by ConnectEvents method.


DoRender Method

Description missing

Syntax

expresssion.DoRender

expression Required. An expression that returns a RenderView object.


DragOutline Method

Begin, continue or end a drag operation.

Syntax

expresssion.DragOutline(Coords, XScreen, YScreen, DragState)

expression Required. An expression that returns a View object.

Coords Required Variant. Array of (X, Y, Z) polygon coordinates.

XScreen Required Double. X coordinate of point in screen coordinate system.

YScreen Required Double. Y coordinate of point in screen coordinate system.

DragState Optional Variant. Begin, continue or end of drag operation


Draw Method

Draws the Graphic object.

Syntax

expresssion.Draw(View)

expression Required. An expression that returns a Graphic object.

View Optional Variant. If supplied, the View object to draw on.


Duplicate Method

Duplicates the object and returns a reference to the new copy.

Syntax 1

expresssion.Duplicate(Name)

expression Required. An expression that returns a NamedColor object.

Name Required String. The name of the NamedColor object.

Return Value

NamedColor. The duplicated NamedColor object.

Syntax 2

expresssion.Duplicate

expression Required. An expression that returns a Vertex object.

Return Value

Vertex. The duplicated Vertex object.

Syntax 3

expresssion.Duplicate

expression Required. An expression that returns a Graphic object.

Return Value

Graphic. The duplicated Graphic object.

Syntax 4

expresssion.Duplicate

expression Required. An expression that returns a Matrix object.

Return Value

Matrix. The duplicated Matrix object.


EndRender Method

Description missing

Syntax

expresssion.EndRender

expression Required. An expression that returns a RenderView object.


Enumerate Method

Returns the ids, names and types of the collection. Some remarks.

Syntax

expresssion.Enumerate(IDs, Names, Types)

expression Required. An expression that returns a Properties object.

IDs Required Variant. An array of longs.

Names Required Variant. An array of strings.

Types Required Variant. An array of longs.


Explode Method

Explodes a group or block insertion. @see TCADAPI TCWExplode function

Syntax

expresssion.Explode

expression Required. An expression that returns a Graphic object.

Return Value

GraphicSet. The exploded Graphic objects.


GetArcData Method

Returns Arc parameter information. Data returned in array is as follows: param[0] X coordinate of center point param[1] Y coordinate of center point param[2] Z coordinate of center point param[3] X coordinate of major axis param[4] Y coordinate of major axis param[5] Z coordinate of major axis param[6] ratio of minor/major axes (1.0 = circle) param[7] start angle in radians param[8] end angle in radians param[9] 0.0 if open arc, 1.0 if closed (ellipse or circle)

Syntax

expresssion.GetArcData(varArcData)

expression Required. An expression that returns a Graphic object.

varArcData Required Variant. Array of 10 double values


GetArray Method

Fills an array with the values of a 4x4 matrix.

Syntax

expresssion.GetArray(ArrayEntries)

expression Required. An expression that returns a Matrix object.

ArrayEntries Required Variant. An array of 16 doubles.


GetDashes Method

Fills an array with dash lengths that make up the LineStyle object.

Syntax

expresssion.GetDashes(Dashes)

expression Required. An expression that returns a LineStyle object.

Dashes Required Variant. An array of doubles.


GetDistance Method

Returns the distance to the specified Graphic object.

Syntax

expresssion.GetDistance(X, Y, Z, ClosestVertex, ClosestChild)

expression Required. An expression that returns a Graphic object.

X Required Double. The x coordinate of the point to be tested.

Y Required Double. The y coordinate of the point to be tested.

Z Required Double. The z coordinate of the point to be tested.

ClosestVertex Required Variant. Description missing

ClosestChild Optional Variant. Description missing

Return Value

Double. Description missing


GetEntries Method

Returns the all entries

Syntax

expresssion.GetEntries(e00, e01, e02, e03, e10, e11, e12, e13, e20, e21, e22, e23, e30, e31, e32, e33)

expression Required. An expression that returns a Matrix object.

e00 Required Double. The entry value.

e01 Required Double. The entry value.

e02 Required Double. The entry value.

e03 Required Double. The entry value.

e10 Required Double. The entry value.

e11 Required Double. The entry value.

e12 Required Double. The entry value.

e13 Required Double. The entry value.

e20 Required Double. The entry value.

e21 Required Double. The entry value.

e22 Required Double. The entry value.

e23 Required Double. The entry value.

e30 Required Double. The entry value.

e31 Required Double. The entry value.

e32 Required Double. The entry value.

e33 Required Double. The entry value.


GetEntry Method

Returns the entry 'e' whith indexes 'i'(row), 'j'(col)

Syntax

expresssion.GetEntry(i, j)

expression Required. An expression that returns a Matrix object.

i Required Long. The x scale factor.

j Required Long. The y scale factor.

Return Value

Double. The entry value.


GetFaceData Method

Returns arrays of face data for a 3d surface Graphic object.

Syntax

expresssion.GetFaceData(VertexArray, VertexIndices, EdgeFlags)

expression Required. An expression that returns a Graphic object.

VertexArray Required Variant. An array of (X, Y, Z) position values

VertexIndices Required Variant. An array of indices into the VertexArray

EdgeFlags Required Variant. An array of flags


GetFaceDimension Method

Returns dimension size for a 3d surface (3DMesh) Graphic object.

Syntax

expresssion.GetFaceDimension(M, N, facetCount)

expression Required. An expression that returns a Graphic object.

M Required Long. Description missing

N Required Long. Description missing

facetCount Required Long. Description missing


GetItem Method

Returns an item in the BrushPattern object.

Syntax

expresssion.GetItem(Index, Dashes, XOrigin, YOrigin, Width, Height, Angle)

expression Required. An expression that returns a BrushPattern object.

Index Required Long. Index of item to return.

Dashes Required Variant. The line style.

XOrigin Required Double. The x coordinate of the pattern's origin.

YOrigin Required Double. The y coordinate of the pattern's origin.

Width Required Double. The width (x axis) of the pattern's origin.

Height Required Double. The height (y axis) of the pattern's origin.

Angle Required Double. The angle of the line in radians.


GetMouseClick Method

Return coordinates of a point in view coordinate system.

Syntax

expresssion.GetMouseClick(X, Y)

expression Required. An expression that returns a View object.

X Required Double. X coordinate of point in view coordinate system.

Y Required Double. Y coordinate of point in view coordinate system.


GetOpenFilename Method

Description missing

Syntax

expresssion.GetOpenFilename(Filter, Title, ButtonText, MultiSelect)

expression Required. An expression that returns an Application object.

Filter Required Variant. If supplied, just use one filter.

Title Optional Variant. Title of dialog box.

ButtonText Optional Variant. Text for OK button.

MultiSelect Optional Variant. True to allow multiple selections.

Return Value

String. File name(s).


GetSaveAsFilename Method

Displays the standard Save As dialog box and gets a filename from the user without actually saving any files.

Syntax

expresssion.GetSaveAsFilename(InitialFilename, Filter, Title, ButtonText)

expression Required. An expression that returns an Application object.

InitialFilename Required Variant. File name to start with.

Filter Optional Variant. If supplied, just use one filter.

Title Optional Variant. Title of dialog box.

ButtonText Optional Variant. Text for OK button.

Return Value

String. File name.


GetSubjectLink Method

Returns a graphic that is linked to this one.

Syntax

expresssion.GetSubjectLink(VertexIndex, LinkIndex)

expression Required. An expression that returns a Graphic object.

VertexIndex Required Variant. The index or Vertex object to search.

LinkIndex Optional Variant. The link to get.

Return Value

Graphic. The linked Graphic object.


GraphicFromID Method

Finds the Graphic object in the collection with the given ID.

Syntax

expresssion.GraphicFromID(ID)

expression Required. An expression that returns a Selection object.

ID Required Long. ID of Graphic object.

Return Value

Graphic. The Graphic object.


Help Method

Displays a Help topic.

Syntax

expresssion.Help(HelpFile, HelpContextID)

expression Required. An expression that returns an Application object.

HelpFile Optional Variant. The name of a help file.

HelpContextID Optional Variant. A help context id.


Identity Method

Sets the Matrix object to an identity matrix.

Syntax

expresssion.Identity

expression Required. An expression that returns a Matrix object.


Inflate Method

Enlarges or shrinks the size of BoundingBox.

Syntax

expresssion.Inflate(InflateBy)

expression Required. An expression that returns a BoundingBox object.

InflateBy Required Double. The amount to enlarge (positive value) or shrink (negative value) the BoundingBox by. The X, Y and Z coordinates of the Min and Max vertices will be adjusted by this amount.


InvalidateObject Method

Repaint the Drawing object in this View object.

Syntax

expresssion.InvalidateObject(Object)

expression Required. An expression that returns a View object.

Object Required Object. Description missing


InvalidateScreenRect Method

Description missing

Syntax

expresssion.InvalidateScreenRect(Left, Top, Width, Height)

expression Required. An expression that returns a View object.

Left Required Double. Description missing

Top Required Double. Description missing

Width Required Double. Description missing

Height Required Double. Description missing


InvalidateViewRect Method

Description missing

Syntax

expresssion.InvalidateViewRect(Left, Top, Width, Height)

expression Required. An expression that returns a View object.

Left Required Double. Description missing

Top Required Double. Description missing

Width Required Double. Description missing

Height Required Double. Description missing


Invert Method

Inverts the Matrix object.

Syntax

expresssion.Invert

expression Required. An expression that returns a Matrix object.


IsEqual Method

Description missing

Syntax

expresssion.IsEqual(pIDisp)

expression Required. An expression that returns a Matrix object.

pIDisp Required Object. Description missing

Return Value

Boolean. Description missing


MessageBox Method

Display a warning or notification message.

Syntax

expresssion.MessageBox(Message, Flags)

expression Required. An expression that returns an Application object.

Message Required String. Message string

Flags Required Variant. MB_ flags for API ::MessageBox call

Return Value

Long. Id of button that dismissed the dialog


MoveAbsolute Method

Moves the Graphic objects in the collection to a new location. @see TCADAPI TCWSelectionMove function.

Syntax

expresssion.MoveAbsolute(X, Y, Z, XRef, YRef, ZRef)

expression Required. An expression that returns a Graphics object.

X Required Double. X coordinate to move to.

Y Required Double. Y coordinate to move to.

Z Required Double. Z coordinate to move to.

XRef Required Variant. X coordinate of the reference point.

YRef Optional Variant. Y coordinate of the reference point.

ZRef Optional Variant. Z coordinate of the reference point.

Return Value

Matrix. The matrix that was calculated.


MoveRelative Method

Moves the Graphic object by a specified offset. @see TCADAPI TCWSelectionMove function.

Syntax

expresssion.MoveRelative(X, Y, Z)

expression Required. An expression that returns a Graphic object.

X Required Double. X offset.

Y Required Double. Y offset.

Z Required Double. Z offset.

Return Value

Matrix. The matrix that was calculated.


Open Method

Opens a previously saved Drawing object. @see TCADAPI TCWDrawingOpen function.

Syntax

expresssion.Open(Filename, ReadOnly, Filter)

expression Required. An expression that returns a Drawings object.

Filename Required String. Name of file to open.

ReadOnly Required Variant. True if opened Drawing object should not be modified.

Filter Optional Variant. Name or index of preferred file filter.

Return Value

Drawing. The opened Drawing object.


OpenBitmapDC Method

Opens a DC for bitmap drawing.

Syntax

expresssion.OpenBitmapDC

expression Required. An expression that returns a View object.

Return Value

Long. The bitmap DC.


OpenMetafileDC Method

Opens a DC for metafile drawing.

Syntax

expresssion.OpenMetafileDC

expression Required. An expression that returns a View object.

Return Value

Long. The metafile DC.


Orbit Method

Orbits the Camera object about the point of interest.

Syntax

expresssion.Orbit(Angle, CameraCoordinates, XOrRight, YOrUp, ZOrDirection)

expression Required. An expression that returns a Camera object.

Angle Required Double. The rotation angle in radians.

CameraCoordinates Optional Variant. True to use camera's coordinate system.

XOrRight Optional Variant. The x or right coordinate of the rotation axis.

YOrUp Optional Variant. The y or up coordinate of the rotation axis.

ZOrDirection Optional Variant. The z or direction coordinate of the rotation axis.


Pan Method

Tilts the Camera object left or right.

Syntax

expresssion.Pan(AngleRight)

expression Required. An expression that returns a Camera object.

AngleRight Required Double. The angle to tilt to the right in radians.


PickInteractive Method

Begins an interactive pick by rectangle.

Syntax

expresssion.PickInteractive(Type, TopLevel, Arcs, Text, Segments, Blocks, Invisible)

expression Required. An expression that returns a Drawing object.

Type Required msiPickType. Point, rect or polygon pick.

TopLevel Required Variant. True if only top level Graphic object's are to be picked.

Arcs Optional Variant. True if arcs should be returned in pick.

Text Optional Variant. True if text should be returned in pick.

Segments Optional Variant. True if only segments should be returned in pick.

Blocks Optional Variant. True if segments in blocks should be returned in pick.

Invisible Optional Variant. True if invisible segements can be picked.

Return Value

PickResult. The result of the pick


PickPoint Method

Pick Graphic objects at a point in view coordinate system.

Syntax

expresssion.PickPoint(X, Y, Aperture, TopLevel, Arcs, Text, Segments, Blocks, Invisible)

expression Required. An expression that returns a View object.

X Required Double. X coordinate of point in view coordinate system.

Y Required Double. Y coordinate of point in view coordinate system.

Aperture Required Variant. Size of aperture in pixels.

TopLevel Optional Variant. True if only top level Graphic object's are to be picked.

Arcs Optional Variant. True if arcs should be returned in pick.

Text Optional Variant. True if text should be returned in pick.

Segments Optional Variant. True if only segments should be returned in pick.

Blocks Optional Variant. True if segments in blocks should be returned in pick.

Invisible Optional Variant. True if invisible segements can be picked.

Return Value

PickResult. The sorted results of the pick operation.


PickRect Method

Pick Graphic objects within a rectangle in the view coordinate system.

Syntax

expresssion.PickRect(Left, Top, Right, Bottom, TopLevel, Arcs, Text, Segments, Blocks, Invisible)

expression Required. An expression that returns a View object.

Left Required Double. X coordinate of left side of rectangle in the view coordinate system.

Top Required Double. Y coordinate of top of rectangle in the view coordinate system.

Right Required Double. X coordinate of right side of rectangle in the view coordinate system.

Bottom Required Double. Y coordinate of bottom of rectangle in the view coordinate system.

TopLevel Required Variant. True if only top level Graphic object's are to be picked.

Arcs Optional Variant. True if arcs should be returned in pick.

Text Optional Variant. True if text should be returned in pick.

Segments Optional Variant. True if only segments should be returned in pick.

Blocks Optional Variant. True if segments in blocks should be returned in pick.

Invisible Optional Variant. True if invisible segements can be picked.

Return Value

PickResult. The sorted results of the pick operation.


PopGraphicDefaults Method

Restores the properties of the Graphic object that will be used as a template for all Graphics.Add calls. Invoke this method to balance a previous call to PushGraphicDefaults.

Syntax

expresssion.PopGraphicDefaults(PrevDefaults)

expression Required. An expression that returns an Application object.

PrevDefaults Optional Variant. The previous default level to restore to.


PopVertexDefaults Method

Restores the properties of the Vertex object that will be used as a template for all Vertices.Add calls. Invoke this method to balance a previous call to PushVertexDefaults.

Syntax

expresssion.PopVertexDefaults(PrevDefaults)

expression Required. An expression that returns an Application object.

PrevDefaults Optional Variant. The previous default level to restore to.


PushGraphicDefaults Method

Sets the properties of the Graphic object that will be used as a template for all Graphics.Add calls. Modifies the existing template according to the optional parameters passed. Restore the existing template by invoking PopGraphicDefaults.

Syntax

expresssion.PushGraphicDefaults(Editable, Visible, Cosmetic, Unbounded)

expression Required. An expression that returns an Application object.

Editable Required Variant. True if the Graphic object can be moved or deleted.

Visible Optional Variant. True if the Graphic object is visible.

Cosmetic Optional Variant. True if the Graphic object is not part of the main graphic.

Unbounded Optional Variant. True if the Graphic object is unbounded.

Return Value

Long. The new default level.


PushVertexDefaults Method

Sets the properties of the Vertex object that will be used as a template for all Vertices.Add calls. Modifies the existing template according to the optional parameters passed. Restore the existing template by invoking PopVertexDefaults.

Syntax

expresssion.PushVertexDefaults(PenDown, Selectable, Snappable, Editable, Linkable, Calculated)

expression Required. An expression that returns an Application object.

PenDown Required Variant. True if the Vertex object should draw.

Selectable Optional Variant. True if the Vertex object can be selected.

Snappable Optional Variant. True if the Vertex object can be snapped to.

Editable Optional Variant. True if the Vertex object can be moved or deleted.

Linkable Optional Variant. True if the Vertex object can be linked to.

Calculated Optional Variant. True if the Vertex object is recalculated by the RegenMethod.

Return Value

Long. The new default level.


QuerySet Method

Returns the Graphic objects in the collection that match a query string. @see TCADAPI TCWSelectByQuery function.

Syntax

expresssion.QuerySet(Query)

expression Required. An expression that returns a Graphics object.

Query Required String. The query string.

Return Value

GraphicSet. The matching Graphic objects, as a GraphicSet__Object.


Quit Method

Quits the application. Does not run any OnClose macros before exiting. @see TCADAPI TCWAppExit function

Syntax

expresssion.Quit

expression Required. An expression that returns an Application object.


Redo Method

Redoes the last user interface action. @see TCADAPI TCWRedo function.

Syntax

expresssion.Redo(Times)

expression Required. An expression that returns a Drawing object.

Times Required Variant. Number of actions to redo.

Return Value

Boolean. True if the redo was successful.


Refresh Method

Repaint the Drawing object in this View object.

Syntax

expresssion.Refresh

expression Required. An expression that returns a View object.


RegenLock Method

Acquires a lock for regen.

Syntax

expresssion.RegenLock

expression Required. An expression that returns a Graphic object.

Return Value

Long. Previous value of lock count.


RegenUnlock Method

Releases a lock for regen.

Syntax

expresssion.RegenUnlock(LockCount)

expression Required. An expression that returns a Graphic object.

LockCount Optional Variant. Lock count to reset to.


Remove Method

Removes an item from the collection.

Syntax 1

expresssion.Remove(Index)

expression Required. An expression that returns a Graphics object.

Index Required Variant. The index of item to be removed.

Return Value

Graphic. The Graphic object that was removed.

Syntax 2

expresssion.Remove(Index)

expression Required. An expression that returns a Vertices object.

Index Required Variant. The index of item to be removed.

Return Value

Vertex. The Vertex object that was removed.


RenderScenesGraphicsUpdate Method

Description missing

Syntax

expresssion.RenderScenesGraphicsUpdate(pDisp, flag)

expression Required. An expression that returns a Drawing object.

pDisp Required Object. Description missing

flag Required __MIDL___MIDL_itf_IMSIGX_0096_0005. Description missing


RenderScenesUpdateChanges Method

Description missing

Syntax

expresssion.RenderScenesUpdateChanges

expression Required. An expression that returns a Drawing object.


Rotate Method

Rotates the Camera object about an arbitrary axis.

Syntax 1

expresssion.Rotate(Angle, CameraCoordinates, XOrRight, YOrUp, ZOrDirection)

expression Required. An expression that returns a Camera object.

Angle Required Double. The rotation angle in radians.

CameraCoordinates Optional Variant. True to use camera's coordinate system.

XOrRight Optional Variant. The x or right coordinate of the rotation axis.

YOrUp Optional Variant. The y or up coordinate of the rotation axis.

ZOrDirection Optional Variant. The z or direction coordinate of the rotation axis.

Syntax 2

expresssion.Rotate(XAxis, YAxis, ZAxis, Angle, XCenter, YCenter, ZCenter, Concat)

expression Required. An expression that returns a Matrix object.

XAxis Required Double. The x coordinate of the rotation axis.

YAxis Required Double. The y coordinate of the rotation axis.

ZAxis Required Double. The z coordinate of the rotation axis.

Angle Required Double. The rotation angle in radians.

XCenter Optional Variant. The x coordinate of the center of rotation.

YCenter Optional Variant. The y coordinate of the center of rotation.

ZCenter Optional Variant. The z coordinate of the center of rotation.

Concat Optional Variant. True to concatenate this to the existing transform.


RotateAbsolute Method

Rotates the Graphic objects in the collection. @see TCADAPI TCWSelectionRotate function.

Syntax

expresssion.RotateAbsolute(XTo, YTo, ZTo, XFrom, YFrom, ZFrom, XRef, YRef, ZRef)

expression Required. An expression that returns a Graphics object.

XTo Required Variant. X coordinate of the point to rotate to.

YTo Required Variant. Y coordinate of the point to rotate to.

ZTo Required Variant. Z coordinate of the point to rotate to.

XFrom Required Variant. X coordinate of the point to rotate from.

YFrom Required Variant. Y coordinate of the point to rotate from.

ZFrom Required Variant. Z coordinate of the point to rotate from.

XRef Required Variant. X coordinate of the rotation center.

YRef Optional Variant. Y coordinate of the rotation center.

ZRef Optional Variant. Z coordinate of the rotation center.

Return Value

Matrix. The matrix that was calculated.


RotateAxis Method

NOTE: The only reason RotateAxis and RotateAbsolute are defined the way they are is because of a MIDL bug that prevents using more than a few double parameters...

Rotates the Graphic object. @see TCADAPI TCWSelectionRotate function.

Syntax

expresssion.RotateAxis(Angle, XAxis, YAxis, ZAxis, X, Y, Z)

expression Required. An expression that returns a Graphic object.

Angle Required Double. Angle of rotation in radians.

XAxis Required Variant. X coordinate of axis direction.

YAxis Optional Variant. Y coordinate of axis direction.

ZAxis Optional Variant. Z coordinate of axis direction.

X Optional Variant. X coordinate of the rotation center.

Y Optional Variant. Y coordinate of the rotation center.

Z Optional Variant. Z coordinate of the rotation center.

Return Value

Matrix. The matrix that was calculated.


RotateDragOutline Method

Description missing

Syntax

expresssion.RotateDragOutline(Coords, Angle, DragState)

expression Required. An expression that returns a View object.

Coords Required Variant. Array of (X, Y, Z) polygon coordinates.

Angle Required Double. Angle of rotation in radians, counterclockwise positive.

DragState Optional Variant. Continue or end of drag operation


Run Method

Description missing

Syntax

expresssion.Run(pView)

expression Required. An expression that returns a Render object.

pView Required IMSIGX.View. Description missing

Return Value

stdole.Picture. Description missing


RunTurboLISP Method

Interpret Expression string using TurboLISP. Returns the result as a String

Syntax

expresssion.RunTurboLISP(Expression)

expression Required. An expression that returns an Application object.

Expression Required String. the LISP expression as a string

Return Value

String. the result as a string


Save Method

Saves changes to the specified Drawing object. @see TCADAPI TCWDrawingSave function.

Syntax

expresssion.Save

expression Required. An expression that returns a Drawing object.


SaveAs Method

Saves the changes to the Drawing object in a different file. @see TCADAPI TCWDrawingSaveAs function.

Syntax

expresssion.SaveAs(Filename, Filter)

expression Required. An expression that returns a Drawing object.

Filename Required String. The file name to save to.

Filter Optional Variant. Name or index of preferred filter.


SaveCopyAs Method

Saves a copy of the Drawing object to a file but does not modify the open Drawing object.

Syntax

expresssion.SaveCopyAs(Filename, Filter)

expression Required. An expression that returns a Drawing object.

Filename Required String. File name to save to.

Filter Optional Variant. Name or index of preferred filter.


Scale Method

Scales the Graphic objects in the collection. @see TCADAPI TCWSelectionScale function.

Syntax 1

expresssion.Scale(XScale, YScale, ZScale, XRef, YRef, ZRef)

expression Required. An expression that returns a Graphics object.

XScale Required Double. X scale factor.

YScale Required Double. Y scale factor.

ZScale Required Double. Z scale factor.

XRef Required Variant. X coordinate of the reference point.

YRef Optional Variant. Y coordinate of the reference point.

ZRef Optional Variant. Z coordinate of the reference point.

Return Value

Matrix. The matrix that was calculated.

Syntax 2

expresssion.Scale(XScale, YScale, ZScale, XCenter, YCenter, ZCenter, Concat)

expression Required. An expression that returns a Matrix object.

XScale Required Double. The x scale factor.

YScale Required Double. The y scale factor.

ZScale Required Double. The z scale factor.

XCenter Optional Variant. The x coordinate of the center of scaling.

YCenter Optional Variant. The y coordinate of the center of scaling.

ZCenter Optional Variant. The z coordinate of the center of scaling.

Concat Optional Variant. True to concatenate this to the existing transform.


ScreenToView Method

Transforms (2D) coordinates from screen space to view space.

Syntax

expresssion.ScreenToView(XScreen, YScreen, XView, YView)

expression Required. An expression that returns a View object.

XScreen Required Double. X coordinate in screen space.

YScreen Required Double. Y coordinate in screen space.

XView Required Double. X coordinate in view space.

YView Required Double. Y coordinate in view space.


Select Method

Selects all the Graphic object's in the collection. @see TCADAPI TCWSelectAll function.

Syntax

expresssion.Select

expression Required. An expression that returns a Layer object.


SelectAll Method

Selects all of the Graphic object's in the PaperSpace object's Graphics collection. Has the same effect as PaperSpace.Graphics.Select.

Syntax

expresssion.SelectAll

expression Required. An expression that returns a PaperSpace object.


SendToBack Method

Sends the Graphic object to the back. @see TCADAPI TCWSendToBack function.

Syntax

expresssion.SendToBack

expression Required. An expression that returns a Graphic object.


Set Method

Sets the BoundingBox object to a point or cube around a specified vertex.

Syntax

expresssion.Set(Center, Size)

expression Required. An expression that returns a BoundingBox object.

Center Optional Variant. A Vertex object specifying the center of the BoundingBox object.

Size Optional Variant. The size of the BoundingBox object.


SetArray Method

Sets the Matrix object from an array with the values of a 4x4 matrix.

Syntax

expresssion.SetArray(ArrayEntries)

expression Required. An expression that returns a Matrix object.

ArrayEntries Required Variant. An array of 16 doubles.


SetEntries Method

Set the all entries

Syntax

expresssion.SetEntries(e00, e01, e02, e03, e10, e11, e12, e13, e20, e21, e22, e23, e30, e31, e32, e33)

expression Required. An expression that returns a Matrix object.

e00 Required Double. The entry value.

e01 Required Double. The entry value.

e02 Required Double. The entry value.

e03 Required Double. The entry value.

e10 Required Double. The entry value.

e11 Required Double. The entry value.

e12 Required Double. The entry value.

e13 Required Double. The entry value.

e20 Required Double. The entry value.

e21 Required Double. The entry value.

e22 Required Double. The entry value.

e23 Required Double. The entry value.

e30 Required Double. The entry value.

e31 Required Double. The entry value.

e32 Required Double. The entry value.

e33 Required Double. The entry value.


SetEntry Method

Set the entry 'e' whith indexes 'i'(row), 'j'(col)

Syntax

expresssion.SetEntry(i, j, e)

expression Required. An expression that returns a Matrix object.

i Required Long. The x scale factor.

j Required Long. The y scale factor.

e Required Double. New entry value.


SetForAll Method

Sets the specific property for all graphics in the set.

Syntax

expresssion.SetForAll(PropertyName, prop)

expression Required. An expression that returns a GraphicSet object.

PropertyName Required Variant. The name of property to set.

prop Required Variant. The Property value.


SetItem Method

Sets an item in the BrushPattern object.

Syntax

expresssion.SetItem(Index, Dashes, XOrigin, YOrigin, Width, Height, Angle)

expression Required. An expression that returns a BrushPattern object.

Index Required Long. Index of item to set.

Dashes Required Variant. The line style.

XOrigin Required Double. The x coordinate of the pattern's origin.

YOrigin Required Double. The y coordinate of the pattern's origin.

Width Required Double. The width (x axis) of the pattern's origin.

Height Required Double. The height (y axis) of the pattern's origin.

Angle Required Double. The angle of the line in radians.


Slide Method

Slides the Camera object perpendicular to its direction vector.

Syntax

expresssion.Slide(DistanceUp, DistanceRight)

expression Required. An expression that returns a Camera object.

DistanceUp Required Double. The distance to slide in the up direction.

DistanceRight Required Double. The distance to slide in the right direction.


TextSet Method

Set the start point, height, width, and other text parameters.

Syntax

expresssion.TextSet(Text, X, Y, Z, Width, Height, Angle)

expression Required. An expression that returns a Graphic object.

Text Optional Variant. The text string

X Optional Variant. X coordinate of text point.

Y Optional Variant. Y coordinate of text point.

Z Optional Variant. Z coordinate of text point.

Width Optional Variant. Width of object.

Height Optional Variant. Height of object.

Angle Optional Variant. Rotation angle of object in radians.


Tilt Method

Tilts the Camera object up or down.

Syntax

expresssion.Tilt(AngleUp)

expression Required. An expression that returns a Camera object.

AngleUp Required Double. The angle to tilt up in radians.


Track Method

Moves the Camera object along its direction vector.

Syntax

expresssion.Track(DistanceForward)

expression Required. An expression that returns a Camera object.

DistanceForward Required Double. The distance to move.


Transform Method

Transforms the Graphic objects in the collection.

Syntax

expresssion.Transform(Transform)

expression Required. An expression that returns a Graphics object.

Transform Required Matrix. The matrix to perform transformation.


Translate Method

Sets the Matrix object to, or transforms the Matrix object by, a translation.

Syntax

expresssion.Translate(X, Y, Z, Concat)

expression Required. An expression that returns a Matrix object.

X Required Double. The x coordinate of the translation.

Y Required Double. The y coordinate of the translation.

Z Required Double. The z coordinate of the translation.

Concat Optional Variant. True to concatenate this to the existing transform.


TranslateScaleAndRotateZ Method

Translates, scales, and rotates around z axis.

Syntax

expresssion.TranslateScaleAndRotateZ(X, Y, Z, XScale, YScale, ZScale, Angle, XCenter, YCenter, ZCenter, Concat)

expression Required. An expression that returns a Matrix object.

X Required Double. X coordinate of the translation.

Y Required Double. Y coordinate of the translation.

Z Required Double. Z coordinate of the translation.

XScale Required Double. X scale factor.

YScale Required Double. Y scale factor.

ZScale Required Double. Z scale factor.

Angle Required Double. Angle of rotation around z axis in radians.

XCenter Optional Variant. The x coordinate of the center of rotation.

YCenter Optional Variant. The y coordinate of the center of rotation.

ZCenter Optional Variant. The z coordinate of the center of rotation.

Concat Optional Variant. True to concatenate this to the existing transform.


Transpose Method

Transposes the Matrix object.

Syntax

expresssion.Transpose

expression Required. An expression that returns a Matrix object.


Undo Method

Cancels the last user interface action.

Syntax

expresssion.Undo(Times)

expression Required. An expression that returns an Application object.

Times Required Variant. Number of actions to undo.

Return Value

Boolean. True if the Undo was successful.


UndoClear Method

Clears all the Drawing object's undo entries. @see TCADAPI TCWUndoClear function.

Syntax

expresssion.UndoClear

expression Required. An expression that returns a Drawing object.


Unselect Method

Unselects all the Graphic object's in the collection. @see TCADAPI TCWDeselectAll function.

Syntax

expresssion.Unselect

expression Required. An expression that returns a Selection object.


UnselectAll Method

Unselects all of the Graphic object's in the PaperSpace object's Graphics collection. Has the same effect as PaperSpace.Graphics.Unselect or PaperSpace.Selection.Unselect.

Syntax

expresssion.UnselectAll

expression Required. An expression that returns a PaperSpace object.


Update Method

Forces an update of the Graphic object's properties.

Syntax

expresssion.Update

expression Required. An expression that returns a Graphic object.


ViewToScreen Method

Transforms (2D) coordinates from view space to screen space.

Syntax

expresssion.ViewToScreen(XView, YView, XScreen, YScreen)

expression Required. An expression that returns a View object.

XView Required Double. X coordinate in view space.

YView Required Double. Y coordinate in view space.

XScreen Required Double. X coordinate in screen space.

YScreen Required Double. Y coordinate in screen space.

Return Value

Boolean. TRUE if transformed point is within Screen rectangle.


ViewToWorld Method

Transforms (3D) coordinates from view CS to world CS.

Syntax

expresssion.ViewToWorld(XView, YView, ZView, XWorld, YWorld, ZWorld)

expression Required. An expression that returns a View object.

XView Required Double. X coordinate in view space.

YView Required Double. Y coordinate in view space.

ZView Required Double. Y coordinate in view space.

XWorld Required Double. X coordinate in screen space.

YWorld Required Double. Y coordinate in screen space.

ZWorld Required Double. Z coordinate in screen space.


WorldToView Method

Transforms (3D) coordinates from world CS to view CS.

Syntax

expresssion.WorldToView(XWorld, YWorld, ZWorld, XView, YView, ZView)

expression Required. An expression that returns a View object.

XWorld Required Double. X coordinate in screen space.

YWorld Required Double. Y coordinate in screen space.

ZWorld Required Double. Z coordinate in screen space.

XView Required Double. X coordinate in view space.

YView Required Double. Y coordinate in view space.

ZView Required Double. Z coordinate in view space.


Zoom Method

Zooms the focal length of the Camera object.

Syntax

expresssion.Zoom(ZoomFactor)

expression Required. An expression that returns a Camera object.

ZoomFactor Required Double. The amount of zoom.


ZoomToExtents Method

Set the View object's extents to those of the drawing.

Syntax

expresssion.ZoomToExtents

expression Required. An expression that returns a View object.


ZoomToNamedView Method

Zooms the View object to a NamedView object

Syntax

expresssion.ZoomToNamedView(NamedView)

expression Required. An expression that returns a View object.

NamedView Required Variant. Description missing


Active Property

Description missing

Syntax

expresssion.Active

expression Required. An expression that returns a PaperSpace object.


ActiveDrawing Property

Returns the active Drawing object.

Syntax

ActiveDrawing


ActiveView Property

Description missing

Syntax

expresssion.ActiveView

expression Required. An expression that returns a Drawing object.


Anchor Property

Returns the anchor point for insertions.

Syntax

expresssion.Anchor

expression Required. An expression that returns a Block object.


Application Property

Returns an Application object that represents the owner of the specified object.

Syntax 1

expresssion.Application

expression Required. An expression that returns a Macros object.

Syntax 2

expresssion.Application

expression Required. An expression that returns a Render object.

Syntax 3

expresssion.Application

expression Required. An expression that returns a PaperSpace object.

Syntax 4

expresssion.Application

expression Required. An expression that returns a TieMethod object.

Syntax 5

expresssion.Application

expression Required. An expression that returns a Tie object.

Syntax 6

expresssion.Application

expression Required. An expression that returns a TieSet object.


Attributes Property

Returns the Graphic object's Attributes collection.

Syntax

expresssion.Attributes

expression Required. An expression that returns a Graphic object.


AutoRedraw Property

Description missing

Syntax

expresssion.AutoRedraw

expression Required. An expression that returns a View object.


Block Property

Returns the Block object referenced by an Insert.

Syntax

expresssion.Block

expression Required. An expression that returns a Graphic object.


Blocks Property

Returns the Drawing object's Blocks collection.

Syntax

expresssion.Blocks

expression Required. An expression that returns a Drawing object.


Blue Property

Returns the blue value of the color.

Syntax

expresssion.Blue

expression Required. An expression that returns a NamedColor object.


BottomMargin Property

Sets the size of the bottom margin, in millimeters.

Syntax

expresssion.BottomMargin

expression Required. An expression that returns a PageSetup object.


BoundingBox Property

Returns the NamedView object's BoundingBox object.

Syntax

expresssion.BoundingBox

expression Required. An expression that returns a NamedView object.


Brightness Property

Sets the brightness value of the color.

Syntax

expresssion.Brightness

expression Required. An expression that returns a NamedColor object.


BrushStyle Property

Returns the Graphic object's brush style.

Syntax 1

expresssion.BrushStyle

expression Required. An expression that returns a Graphic object.

Syntax 2

expresssion.BrushStyle

expression Required. An expression that returns a Graphic object.

Syntax 3

expresssion.BrushStyle

expression Required. An expression that returns a Layer object.


BrushStyles Property

Returns the Drawing object's BrushStyles collection.

Syntax

expresssion.BrushStyles

expression Required. An expression that returns a Drawing object.


Build Property

Returns the build number, as a string.

Syntax

expresssion.Build(lcid)

expression Required. An expression that returns an Application object.

lcid Required Long. Description missing


Builtin Property

True if the object is built-in.

Syntax

expresssion.Builtin

expression Required. An expression that returns a Graphic object.


Bulge Property

A Boolean flag that signals whether the Vertex object contained by a polyline graphic is part of an arc segment definition.

Syntax

expresssion.Bulge

expression Required. An expression that returns a Vertex object.

Remarks

The Bulge flag is set to True only for vertices that define elliptical arc segments in 2D polyline graphics. The following picture shows a polyline that contains arc segments, with the Bulge vertices indicated:

Insert picture of polyline with bulge vertices shown

For more information on 2D polylines and the use of the Bulge property, see the In Depth section.


Calculated Property

A Boolean flag that indicates whether the Vertex object will be recalculated by the graphic that owns it.

Syntax

expresssion.Calculated

expression Required. An expression that returns a Vertex object.

Remarks

The coordinates of calculated vertices should only be modified by the regen method of the owning graphic. If you attempt to modify the location of a calculated vertex, the location information will probably remain as you set it only until the next update of the graphic.


Camera Property

Returns the camera that controls the View object.

Syntax

expresssion.Camera

expression Required. An expression that returns a View object.


Capability Property

Description missing

Syntax

expresssion.Capability

expression Required. An expression that returns a Filter object.


Category Property

Sets the name of the Tool object's category, as a string.

Syntax

expresssion.Category(lcid)

expression Required. An expression that returns a Tool object.

lcid Required Long. Description missing


CenterOnExtents Property

True if the View object's extents are centered within the Window.

Syntax

expresssion.CenterOnExtents

expression Required. An expression that returns a View object.


Closed Property

True if the Graphic object is a closed figure.

Syntax

expresssion.Closed

expression Required. An expression that returns a Graphic object.


ClosestChildGraphic Property

Returns the closest child Graphic object in the Graphic object.

Syntax

expresssion.ClosestChildGraphic

expression Required. An expression that returns a PickEntry object.


ClosestSegmentVertex Property

Returns the closest Vertex object on the closest segment of the entity.

Syntax

expresssion.ClosestSegmentVertex

expression Required. An expression that returns a PickEntry object.


ClosestVertex Property

Returns the closest point on the entity.

Syntax

expresssion.ClosestVertex

expression Required. An expression that returns a PickEntry object.


Color Property

Sets the RGB value of the color.

Syntax

expresssion.Color

expression Required. An expression that returns a NamedColor object.


Columns Property

Sets the number of columns necessary to tile the sheet height.

Syntax

expresssion.Columns

expression Required. An expression that returns a PageSetup object.


CommandName Property

Returns the name of the object, as a string.

Syntax

expresssion.CommandName(lcid)

expression Required. An expression that returns a Tool object.

lcid Required Long. Description missing


Cosmetic Property

True if the Graphic object is used for display regeneration only.

Syntax

expresssion.Cosmetic

expression Required. An expression that returns a Graphic object.


Count Property

Returns the number of items in the collection.

Syntax

expresssion.Count

expression Required. An expression that returns a RegenMethods object.


Data Property

Description missing

Syntax

expresssion.Data

expression Required. An expression that returns a Tie object.


DC Property

Returns the DC associated with this View object.

Syntax

expresssion.DC

expression Required. An expression that returns a View object.


DefaultMode Property

Description missing

Syntax

expresssion.DefaultMode

expression Required. An expression that returns a Render object.


Deleted Property

True if the Graphic object is on the purge/undo list.

Syntax

expresssion.Deleted

expression Required. An expression that returns a Graphic object.


Description Property

Returns a description of the specified object, as a string.

Syntax

expresssion.Description

expression Required. An expression that returns a TieMethod object.


Direction Property

Sets the Camera object's direction vector.

Syntax

expresssion.Direction

expression Required. An expression that returns a Camera object.


Distance Property

Returns the distance from the pick ray to the closest point on the entity.

Syntax

expresssion.Distance

expression Required. An expression that returns a PickEntry object.


Domain Property

Returns the type of the Property object's container.

Syntax

expresssion.Domain

expression Required. An expression that returns a Property object.


Drawing Property

Returns an Drawing object that represents the owner of the specified object.

Syntax 1

expresssion.Drawing

expression Required. An expression that returns a TieSet object.

Syntax 2

expresssion.Drawing

expression Required. An expression that returns a GraphicSet object.

Syntax 3

expresssion.Drawing

expression Required. An expression that returns a View object.

Syntax 4

expresssion.Drawing

expression Required. An expression that returns a PageSetup object.

Syntax 5

expresssion.Drawing

expression Required. An expression that returns a Block object.

Syntax 6

expresssion.Drawing

expression Required. An expression that returns a Graphics object.

Syntax 7

expresssion.Drawing

expression Required. An expression that returns a Selection object.

Syntax 8

expresssion.Drawing

expression Required. An expression that returns a Graphic object.

Syntax 9

expresssion.Drawing

expression Required. An expression that returns a Layer object.

Syntax 10

expresssion.Drawing

expression Required. An expression that returns a Macro object.

Syntax 11

expresssion.Drawing

expression Required. An expression that returns an UndoRecord object.

Syntax 12

expresssion.Drawing

expression Required. An expression that returns a GraphicSets object.

Syntax 13

expresssion.Drawing

expression Required. An expression that returns a NamedView object.


Drawings Property

Returns the Application object's Drawings collection, the collection of Drawing objects.

Syntax

Drawings


Editable Property

True if Graphic objects on the Layer object can be edited.

Syntax

expresssion.Editable

expression Required. An expression that returns a Layer object.


Empty Property

Returns True if the BoundingBox object empty.

Syntax

expresssion.Empty

expression Required. An expression that returns a BoundingBox object.


Enabled Property

True if the object is enabled.

Syntax

expresssion.Enabled

expression Required. An expression that returns a Tool object.


Extension Property

Returns a file extension supported by the Filter object.

Syntax

expresssion.Extension(Index)

expression Required. An expression that returns a Filter object.

Index Required Variant. The index of the extension.


ExtensionCount Property

Returns the number of file extensions supported by the Filter object.

Syntax

expresssion.ExtensionCount

expression Required. An expression that returns a Filter object.


ExternalView Property

Description missing

Syntax

expresssion.ExternalView

expression Required. An expression that returns a View object.


Filters Property

Returns the Application object's Filters collection.

Syntax

expresssion.Filters

expression Required. An expression that returns an Application object.


FilterString Property

Returns a the Windows Common Dialog filter string.

Syntax

expresssion.FilterString

expression Required. An expression that returns a Filter object.


FixedAspectRatio Property

True if the View object's mapping is isotropic.

Syntax

expresssion.FixedAspectRatio

expression Required. An expression that returns a View object.


Flag Property

Description missing

Syntax

expresssion.Flag(FlagMask)

expression Required. An expression that returns a TieSet object.

FlagMask Required __MIDL___MIDL_itf_GXTIES_0000_0001. Description missing


Flags Property

Description missing

Syntax

expresssion.Flags

expression Required. An expression that returns a TieSet object.


Frozen Property

True if Graphic objects on the Layer object cannot be edited or selected.

Syntax

expresssion.Frozen

expression Required. An expression that returns a Layer object.


Graphic Property

Returns the PickEntry object's Graphic object.

Syntax

expresssion.Graphic

expression Required. An expression that returns a PickEntry object.


Graphics Property

Returns the Drawing object's Graphics collection.

Syntax 1

expresssion.Graphics

expression Required. An expression that returns a Drawing object.

Syntax 2

expresssion.Graphics

expression Required. An expression that returns a PaperSpace object.


GraphicSets Property

Returns the Drawing object's GraphicSets collection.

Syntax

expresssion.GraphicSets

expression Required. An expression that returns a Drawing object.


Green Property

Returns the green value of the color.

Syntax

expresssion.Green

expression Required. An expression that returns a NamedColor object.


Hidden Property

Description missing

Syntax

expresssion.Hidden

expression Required. An expression that returns a Filter object.


Hue Property

Sets the hue of the color.

Syntax

expresssion.Hue

expression Required. An expression that returns a NamedColor object.


HWND Property

The HWND value of the View object's display Window.

Syntax

expresssion.HWND

expression Required. An expression that returns a View object.


ID Property

Returns the Graphic object's database ID.

Syntax

expresssion.ID

expression Required. An expression that returns a Graphic object.


Index Property

Returns the index of the item in the collection.

Syntax

expresssion.Index

expression Required. An expression that returns a NamedColor object.


IsAttribute Property

True if the object is an attribute.

Syntax

expresssion.IsAttribute

expression Required. An expression that returns a Property object.


IsRenderRunned Property

Description missing

Syntax

expresssion.IsRenderRunned

expression Required. An expression that returns a RenderView object.


Item Property

Returns part of a collection.

Syntax 1

expresssion.Item(Index)

expression Required. An expression that returns a Graphics object.

Index Required Variant. Index of item to return.

Syntax 2

expresssion.Item(Index)

expression Required. An expression that returns a GraphicSets object.

Index Required Variant. Index of item to return.

Syntax 3

expresssion.Item(Index)

expression Required. An expression that returns a PickResult object.

Index Required Variant. Index of item to return.

Syntax 4

expresssion.Item(Index)

expression Required. An expression that returns a LineStyles object.

Index Required Variant. Index of item to return.

Syntax 5

expresssion.Item(Index)

expression Required. An expression that returns a Filters object.

Index Required Variant. Index of item to return.

Syntax 6

expresssion.Item(Index)

expression Required. An expression that returns a Macros object.

Index Required Variant. Index of item to return.

Syntax 7

expresssion.Item(Index)

expression Required. An expression that returns a TieSet object.

Index Required Long. Zero-based Index of item to return.

Syntax 8

expresssion.Item(Index)

expression Required. An expression that returns a NamedColors object.

Index Required Variant. Index of item to return.

Syntax 9

expresssion.Item(Index)

expression Required. An expression that returns a NamedViews object.

Index Required Variant. Index of item to return.

Syntax 10

expresssion.Item(Index)

expression Required. An expression that returns a Layers object.

Index Required Variant. Index of item to return.

Syntax 11

expresssion.Item(Index)

expression Required. An expression that returns a Drawings object.

Index Required Variant. Index of item to return.

Syntax 12

expresssion.Item(Index)

expression Required. An expression that returns a Properties object.

Index Required Variant. Index of item to return.

Syntax 13

expresssion.Item(Index)

expression Required. An expression that returns a BrushStyles object.

Index Required Variant. Index of item to return.

Syntax 14

expresssion.Item(Index)

expression Required. An expression that returns a RegenMethods object.

Index Required Variant. Index of item to return.

Syntax 15

expresssion.Item(Index)

expression Required. An expression that returns a Vertices object.

Index Required Variant. Index of item to return.

Syntax 16

expresssion.Item(Index)

expression Required. An expression that returns a BrushPatterns object.

Index Required Variant. Index of item to return.

Syntax 17

expresssion.Item(Index)

expression Required. An expression that returns a Blocks object.

Index Required Variant. Index of item to return.

Syntax 18

expresssion.Item(Index)

expression Required. An expression that returns a Views object.

Index Required Variant. Index of item to return.


Layer Property

Returns the Graphic object's layer.

Syntax 1

expresssion.Layer

expression Required. An expression that returns a Graphic object.

Syntax 2

expresssion.Layer

expression Required. An expression that returns a Graphic object.


Layers Property

Returns the Drawing object's Layers collection.

Syntax

expresssion.Layers

expression Required. An expression that returns a Drawing object.


LeftMargin Property

Returns the size of the left margin, in millimeters.

Syntax

expresssion.LeftMargin

expression Required. An expression that returns a PageSetup object.


LineStyle Property

Returns the Graphic object's LineStyle object.

Syntax 1

expresssion.LineStyle

expression Required. An expression that returns a Graphic object.

Syntax 2

expresssion.LineStyle

expression Required. An expression that returns a Graphic object.

Syntax 3

expresssion.LineStyle

expression Required. An expression that returns a Layer object.


LineStyles Property

Returns the Drawing object's LineStyles collection.

Syntax

expresssion.LineStyles

expression Required. An expression that returns a Drawing object.


Linkable Property

A Boolean flag that signals whether the Vertex can be tied to vertices in other graphics.

Syntax

expresssion.Linkable

expression Required. An expression that returns a Vertex object.

Remarks

The Linkable flag is checked by TurboCAD's internal tie mechanisms. Linkable vertices are used in associative dimensioning.


Location Property

Returns the Camera object's location.

Syntax

expresssion.Location

expression Required. An expression that returns a Camera object.


LookAt Property

Sets the Camera object's point of interest.

Syntax

expresssion.LookAt

expression Required. An expression that returns a Camera object.


Macros Property

Returns the Drawing object's NamedViews collection.

Syntax

expresssion.Macros

expression Required. An expression that returns a Drawing object.


MappingMode Property

Sets the mapping mode of the View object's display Window.

Syntax

expresssion.MappingMode

expression Required. An expression that returns a View object.


Margins Property

True if the View object's display window is inset within its client rectangle.

Syntax

expresssion.Margins

expression Required. An expression that returns a View object.


Max Property

Read only. A Vertex object contining the maximum X, Y and Z coordinates of the BoundingBox.

Syntax

expresssion.Max

expression Required. An expression that returns a BoundingBox object.


MenuText Property

Returns the string that will appear in the Undo menu item.

Syntax

expresssion.MenuText

expression Required. An expression that returns an UndoRecord object.


Min Property

Read only. A Vertex object contining the minimum X, Y and Z coordinates of the BoundingBox.

Syntax

expresssion.Min

expression Required. An expression that returns a BoundingBox object.


Modes Property

Description missing

Syntax

expresssion.Modes

expression Required. An expression that returns a Render object.


Name Property

Returns the name of the object, as a string.

Syntax

expresssion.Name

expression Required. An expression that returns a RegenMethod object.


NamedColors Property

Returns the Application object's NamedColors collection.

Syntax

expresssion.NamedColors

expression Required. An expression that returns an Application object.


NamedViews Property

Returns the Drawing object's NamedViews collection.

Syntax

expresssion.NamedViews

expression Required. An expression that returns a Drawing object.


Nodes Property

Returns the Vertices collection which represents the editable child Vertex objects of this Graphic object.

Syntax

expresssion.Nodes

expression Required. An expression that returns a Graphic object.


OpenFlat Property

Returns True if the Filter object can load from a flat file.

Syntax

expresssion.OpenFlat

expression Required. An expression that returns a Filter object.


OpenStream Property

Returns True if the Filter object can load from an OLE stream.

Syntax

expresssion.OpenStream

expression Required. An expression that returns a Filter object.


PageSetup Property

Returns the Drawing object's PgSetObj.

Syntax

expresssion.PageSetup

expression Required. An expression that returns a Drawing object.


PaperSpaces Property

Returns the Drawing object's PaperSpaces collection.

Syntax

expresssion.PaperSpaces

expression Required. An expression that returns a Drawing object.


Parent Property

Returns the parent object for the specified object.

Syntax 1

expresssion.Parent

expression Required. An expression that returns a GraphicSet object.

Syntax 2

expresssion.Parent

expression Required. An expression that returns a Drawing object.

Syntax 3

expresssion.Parent

expression Required. An expression that returns a View object.

Syntax 4

expresssion.Parent

expression Required. An expression that returns an Application object.

Syntax 5

expresssion.Parent

expression Required. An expression that returns a GraphicSets object.

Syntax 6

expresssion.Parent

expression Required. An expression that returns a Views object.

Syntax 7

expresssion.Parent

expression Required. An expression that returns a Drawings object.

Syntax 8

Parent

Syntax 9

expresssion.Parent

expression Required. An expression that returns a PageSetup object.

Syntax 10

expresssion.Parent

expression Required. An expression that returns a Tool object.

Syntax 11

expresssion.Parent

expression Required. An expression that returns a Tools object.


Path Property

Returns the complete path of the object, as a string, without including the final separator and name of the object.

Syntax

expresssion.Path(lcid)

expression Required. An expression that returns an Application object.

lcid Required Long. Description missing


PenDown Property

A Boolean flag that signals that the segment from this Vertex to the next Vertex in a polyline should be drawn.

Syntax

expresssion.PenDown

expression Required. An expression that returns a Vertex object.

Remarks

The PenDown flag is normally set for newly created vertices. Graphic subtypes other than polylines, that have specific uses for particular vertices may ignore the PenDown flag. See the In Depth section of the documentation for information on specific graphic subtypes and their use of the PenDown flag.


Perspective Property

Description missing

Syntax

expresssion.Perspective

expression Required. An expression that returns a Camera object.


PerspectiveAngle Property

Description missing

Syntax

expresssion.PerspectiveAngle

expression Required. An expression that returns a Camera object.


PickVertex Property

Returns the actual vertex of the mouse click

Syntax

expresssion.PickVertex

expression Required. An expression that returns a PickResult object.


Picture Property

Description missing

Syntax

expresssion.Picture

expression Required. An expression that returns a RenderView object.


PrinterHeight Property

Sets the printer paper height, in millimeters.

Syntax

expresssion.PrinterHeight

expression Required. An expression that returns a PageSetup object.


PrinterOrientation Property

Sets the printer paper orientation.

Syntax

expresssion.PrinterOrientation

expression Required. An expression that returns a PageSetup object.


PrinterWidth Property

Sets the printer paper width, in millimeters.

Syntax

expresssion.PrinterWidth

expression Required. An expression that returns a PageSetup object.


Priority Property

Returns the Filter object's priority.

Syntax 1

expresssion.Priority

expression Required. An expression that returns a Filter object.

Syntax 2

expresssion.Priority

expression Required. An expression that returns a Tie object.

Syntax 3

expresssion.Priority

expression Required. An expression that returns a Tie object.


ProfileName Property

Returns the profile name.

Syntax

expresssion.ProfileName(lcid)

expression Required. An expression that returns an Application object.

lcid Required Long. Description missing


Prompt Property

Returns the string that will appear in the status bar.

Syntax

expresssion.Prompt(lcid)

expression Required. An expression that returns a Tool object.

lcid Required Long. Description missing


Properties Property

Returns the Application object's Properties collection. For the complete list of available Application Properties, follow this link. @see TCADAPI TCWAppPropertyGet/Set functions

Syntax 1

expresssion.Properties

expression Required. An expression that returns an Application object.

Syntax 2

expresssion.Properties

expression Required. An expression that returns a PaperSpace object.


RadExtendedMode Property

Description missing

Syntax

expresssion.RadExtendedMode

expression Required. An expression that returns a Render object.


RadExtendedModes Property

Description missing

Syntax

expresssion.RadExtendedModes

expression Required. An expression that returns a Render object.


RadExtendedRenderModesCount Property

Description missing

Syntax

expresssion.RadExtendedRenderModesCount

expression Required. An expression that returns a Render object.


RadIterationsCount Property

Description missing

Syntax

expresssion.RadIterationsCount

expression Required. An expression that returns a Render object.


RadMaxArea Property

Description missing

Syntax

expresssion.RadMaxArea

expression Required. An expression that returns a Render object.


RadMinArea Property

Description missing

Syntax

expresssion.RadMinArea

expression Required. An expression that returns a Render object.


RadQuality Property

Description missing

Syntax

expresssion.RadQuality

expression Required. An expression that returns a Render object.


Red Property

Returns the red value of the color.

Syntax

expresssion.Red

expression Required. An expression that returns a NamedColor object.


ReferencePoint Property

Description missing

Syntax

expresssion.ReferencePoint(bUseWorldCS)

expression Required. An expression that returns a Graphic object.

bUseWorldCS Required Variant. Description missing


RegenMethods Property

Returns the Application object's RegenMethods collection.

Syntax

RegenMethods


RegenType Property

Returns the Graphic object's regen type.

Syntax

expresssion.RegenType

expression Required. An expression that returns a Graphic object.


RelativeOrigin Property

Returns the location of the relative origin, as a Vertex object.

Syntax

expresssion.RelativeOrigin

expression Required. An expression that returns a Drawing object.


RenderID Property

Description missing

Syntax

expresssion.RenderID

expression Required. An expression that returns a RenderView object.


RenderMode Property

Description missing

Syntax

expresssion.RenderMode

expression Required. An expression that returns a RenderView object.


RenderModesCount Property

Description missing

Syntax

expresssion.RenderModesCount

expression Required. An expression that returns a Render object.


Renders Property

Returns the Application object's Renders collection.

Syntax

expresssion.Renders

expression Required. An expression that returns an Application object.


RenderView Property

Returns the RenderView that controls the View object.

Syntax

expresssion.RenderView

expression Required. An expression that returns a View object.


Right Property

Sets the Camera object's right vector.

Syntax

expresssion.Right

expression Required. An expression that returns a Camera object.


RightMargin Property

Sets the size of the right margin, in millimeters.

Syntax

expresssion.RightMargin

expression Required. An expression that returns a PageSetup object.


Root Property

True if the Graphic object is the root of a tree.

Syntax

expresssion.Root

expression Required. An expression that returns a Graphic object.


Rows Property

Sets the number of rows necessary to tile the sheet width.

Syntax

expresssion.Rows

expression Required. An expression that returns a PageSetup object.


Saturation Property

Returns the saturation value of the color.

Syntax

expresssion.Saturation

expression Required. An expression that returns a NamedColor object.


Saved Property

True if no changes have been made to the Drawing object since it was last saved.

Syntax

expresssion.Saved

expression Required. An expression that returns a Drawing object.


SaveFlat Property

Returns True if the Filter object can save to a flat file.

Syntax

expresssion.SaveFlat

expression Required. An expression that returns a Filter object.


SaveStream Property

Returns True if the Filter object can save to an OLE stream.

Syntax

expresssion.SaveStream

expression Required. An expression that returns a Filter object.


Scale Property

Sets the drawing scale, as a number or string.

Syntax 1

expresssion.Scale

expression Required. An expression that returns a PageSetup object.

Syntax 2

expresssion.Scale

expression Required. An expression that returns a PageSetup object.


ScreenHeight Property

The height in the View object's screen space.

Syntax

expresssion.ScreenHeight

expression Required. An expression that returns a View object.


ScreenLeft Property

The x coordinate of the left hand side of the View object's screen space.

Syntax

expresssion.ScreenLeft

expression Required. An expression that returns a View object.


ScreenTop Property

The y coordinate of the top of the View object's screen space.

Syntax

expresssion.ScreenTop

expression Required. An expression that returns a View object.


ScreenWidth Property

The width in the View object's screen space.

Syntax

expresssion.ScreenWidth

expression Required. An expression that returns a View object.


Selectable Property

A Boolean flag that signals that this Vertex can be selected in the user interface.

Syntax

expresssion.Selectable

expression Required. An expression that returns a Vertex object.


Selected Property

Description missing

Syntax

expresssion.Selected

expression Required. An expression that returns a Graphic object.


Selection Property

Returns the Drawing object's Selection object.

Syntax

expresssion.Selection

expression Required. An expression that returns a Drawing object.


SheetHeight Property

Returns the sheet height, in millimeters.

Syntax

expresssion.SheetHeight

expression Required. An expression that returns a PageSetup object.


SheetOrientation Property

Returns the sheet orientation.

Syntax

expresssion.SheetOrientation

expression Required. An expression that returns a PageSetup object.


SheetWidth Property

Sets the sheet width, in millimeters.

Syntax

expresssion.SheetWidth

expression Required. An expression that returns a PageSetup object.


SnapModes Property

Returns the active snap modes.

A long integer that can be tested against the ImsiSnapMode enumerated values.

Syntax

expresssion.SnapModes

expression Required. An expression that returns an Application object.


Snappable Property

A Boolean flag that signals that the Vertex can be snapped to in the user interface.

Syntax

expresssion.Snappable

expression Required. An expression that returns a Vertex object.


SpaceMode Property

Description missing

Syntax

expresssion.SpaceMode

expression Required. An expression that returns a View object.


Subject Property

Description missing

Syntax

expresssion.Subject

expression Required. An expression that returns a TieSet object.


Subordinate Property

Description missing

Syntax

expresssion.Subordinate

expression Required. An expression that returns a TieSet object.


Surface Property

Returns surface object for imsiSurface Graphic object.

Syntax

expresssion.Surface

expression Required. An expression that returns a Graphic object.


TieMethods Property

Returns the Application object's TieMethods collection.

Syntax

expresssion.TieMethods

expression Required. An expression that returns an Application object.


TieSet Property

Returns part of a collection.

Syntax

expresssion.TieSet(varSbj, varSbd)

expression Required. An expression that returns a TieSets object.

varSbj Required Variant. ID / Dispatch of Subject Graphic.

varSbd Required Variant. ID / Dispatch of Subordinate Graphic


TieSets Property

Returns the Drawing object's TieSets collection.

Syntax

expresssion.TieSets

expression Required. An expression that returns a Drawing object.


ToolEvents Property

Description missing

Syntax

ToolEvents


TooltipText Property

Sets the string that will appear in tool tips.

Syntax

expresssion.TooltipText(lcid)

expression Required. An expression that returns a Tool object.

lcid Required Long. Description missing


TopMargin Property

Sets the size of the top margin, in millimeters.

Syntax

expresssion.TopMargin

expression Required. An expression that returns a PageSetup object.


Type Property

Returns the type of the RegenMethod object.

Syntax 1

expresssion.Type

expression Required. An expression that returns a RegenMethod object.

Syntax 2

expresssion.Type

expression Required. An expression that returns a Graphic object.

Syntax 3

expresssion.Type

expression Required. An expression that returns a BrushStyle object.

Syntax 4

expresssion.Type

expression Required. An expression that returns a Property object.

Syntax 5

expresssion.Type

expression Required. An expression that returns a Render object.


TypeByValue Property

Returns the Graphic object's type, as an enumerated value.

Syntax

expresssion.TypeByValue

expression Required. An expression that returns a Graphic object.


UCS Property

Returns the Drawing CS as Matrix object

Syntax

expresssion.UCS

expression Required. An expression that returns a Drawing object.


Unbounded Property

True if the Graphic object is unbounded.

Syntax

expresssion.Unbounded

expression Required. An expression that returns a Graphic object.


Up Property

Returns the Camera object's up vector.

Syntax

expresssion.Up

expression Required. An expression that returns a Camera object.


Update Property

True if changes to the View object parameters will be immmediately reflected.

Syntax

expresssion.Update

expression Required. An expression that returns a View object.


UserControl Property

True if the user interface is active.

Syntax

expresssion.UserControl

expression Required. An expression that returns an Application object.


UseWorldCS Property

Description missing

Syntax

expresssion.UseWorldCS

expression Required. An expression that returns a Vertices object.


Value Property

Sets the value of the Property object.

Syntax

expresssion.Value(lcid)

expression Required. An expression that returns a Property object.

lcid Required Long. Description missing


Version Property

Returns the version number of TurboCAD, as a string.

Syntax

expresssion.Version(lcid)

expression Required. An expression that returns an Application object.

lcid Required Long. Description missing


Vertices Property

Returns the active snap modes at the time the pick was made.

Returns a Vertices collection which contains the vertex or vertices which defined the pick.

Syntax

expresssion.Vertices

expression Required. An expression that returns a PickResult object.


View Property

Returns the Drawing object that owns the object.

Syntax

expresssion.View

expression Required. An expression that returns a RenderView object.


ViewHeight Property

The height in the View object's view space.

Syntax

expresssion.ViewHeight

expression Required. An expression that returns a View object.


ViewLeft Property

The x coordinate of the left hand side of the View object's view space.

Syntax

expresssion.ViewLeft

expression Required. An expression that returns a View object.


Views Property

Returns the Drawing object's Views collection.

Syntax

expresssion.Views

expression Required. An expression that returns a Drawing object.


ViewTop Property

The y coordinate of the top of the View object's view space.

Syntax

expresssion.ViewTop

expression Required. An expression that returns a View object.


ViewWidth Property

The width in the View object's view space.

Syntax

expresssion.ViewWidth

expression Required. An expression that returns a View object.


Visible Property

True if Graphic objects on the Layer object can be displayed.

Syntax

expresssion.Visible

expression Required. An expression that returns a Layer object.


X Property

The x coordinate value of a point or direction vector in three dimensional space.

Syntax

expresssion.X

expression Required. An expression that returns a Vertex object.


XRef Property

Returns the anchor point for insertions.

Syntax

expresssion.XRef

expression Required. An expression that returns a Block object.


XRefPath Property

HRESULT XRefPath [in] BSTR prop // The path to the referencing file . ); / Returns the path to the referencing file if Block is eXternal Reference. / [ propget 0x1024000C ,helpstring("Returns the path to the referencing file if Block is eXternal Reference.") ]

Syntax

expresssion.XRefPath

expression Required. An expression that returns a Block object.


Y Property

The y coordinate value of a point or direction vector in three dimensional space.

Syntax

expresssion.Y

expression Required. An expression that returns a Vertex object.


Z Property

The z coordinate value of a point or direction vector in three dimensional space.

Syntax

expresssion.Z

expression Required. An expression that returns a Vertex object.


ZOrder Property

Sets the Layer object's redraw order.

Syntax

expresssion.ZOrder

expression Required. An expression that returns a Layer object.


Building Advanced Projects with the SDK

This section will discuss building servers, ties, filters, regen methods, standalone CAD applications and other projects that require an outside compiler.


SDK Documentation Banners

Here are some of the banners submitted by our beta testers. If you'd like to submit your own, just post it on the TurboCAD beta forum, or mail it to us. Banners should be 400x40 pixels in size, and ideally should contain only the words "TurboCAD SDK Documentation".


Beta TurboCAD SDK Download

Terms and Conditions

The SDK binaries you obtain here are for testing purposes only, and are not designed for producing final, production macros or applications. If you proceed to download these files, you are agreeing that any macros or applications built with this SDK, as well as the SDK itself, will not be distributed to other parties, for commercial or non-commercial purposes other than those specifically listed below.

You may distribute macros and applications to others within your organization, but only for the purposes of evaluating and testing. License contracts that will be contained in the final release of the SDK will permit you to build and distribute macros and applications for other commercial and non-commercial purposes. Until you have agreed to such license contracts, any distribution of the SDK or products built with the SDK for purposes of anything other than testing and evaluation is not permitted. Due to royalty agreements that IMSI maintains with some of its technology vendors, IMSI can and will enforce these restrictions. For more information on our licensing plans, see the end-user and developer license agreements, or contact the SDK Team.

Download Files

Please enter your email address for our records:

If you agree to the terms oulined above, click the button below to proceed to the download area.


_PickPoint Method

Description missing

Syntax

expresssion._PickPoint(X, Y, Aperture, Snap, GGD, bTopLevel, bInvisible)

expression Required. An expression that returns a View object.

X Required Double. Description missing

Y Required Double. Description missing

Aperture Required Double. Description missing

Snap Required Long. Description missing

GGD Required Long. Description missing

bTopLevel Required Boolean. Description missing

bInvisible Required Boolean. Description missing

Return Value

PickResult. Description missing


_PickRect Method

Description missing

Syntax

expresssion._PickRect(Left, Top, Right, Bottom, Snap, GGD, bTopLevel, bInvisible)

expression Required. An expression that returns a View object.

Left Required Double. Description missing

Top Required Double. Description missing

Right Required Double. Description missing

Bottom Required Double. Description missing

Snap Required Long. Description missing

GGD Required Long. Description missing

bTopLevel Required Boolean. Description missing

bInvisible Required Boolean. Description missing

Return Value

PickResult. Description missing


_VirtualIntersection Method

Description missing

Syntax

expresssion._VirtualIntersection(V, g1, g2)

expression Required. An expression that returns a View object.

V Required Long. Description missing

g1 Required Long. Description missing

g2 Required Long. Description missing

Return Value

PickResult. Description missing


ApplicationEvents Object

ApplicationEvents object

[[[describe object and uses here]]]


PageSetup Object

diagram

[[[describe object and uses here]]]


Ties Collection Object

Drawings collection (Drawing object)
TieSets collection (TieSet object)
Ties collection (Tie object)

[[[describe object and uses here]]]


BETA TurboCAD SDK Documentation

Send comments to tcsdkbeta@imsisoft.com.
Updated July 20, 2001. What's New...
Request a copy of the SDK.


Examples - File Converter Application - frmConverter.frm

frmConverter.frm

File Converter Application Example

VERSION 5.00
Begin VB.Form frmConvert
   Caption         =   "TurboCAD SDK file converter"
   ClientHeight    =   6960
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   11415
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6960
   ScaleWidth      =   11415
   StartUpPosition =   3  'Windows Default
   Begin VB.Timer Timer1
      Enabled         =   0   'False
      Interval        =   500
      Left            =   5040
      Top             =   5760
   End
   Begin VB.ComboBox Combo2
      Height          =   315
      Left            =   6960
      Style           =   2  'Dropdown List
      TabIndex        =   18
      Top             =   5280
      Width           =   4215
   End
   Begin VB.ComboBox Combo1
      Height          =   315
      ItemData        =   "frmConverter.frx":0000
      Left            =   1320
      List            =   "frmConverter.frx":0002
      MousePointer    =   1  'Arrow
      Style           =   2  'Dropdown List
      TabIndex        =   17
      Top             =   5280
      Width           =   4215
   End
   Begin VB.DriveListBox Drive2
      Height          =   315
      Left            =   6000
      TabIndex        =   7
      Top             =   1080
      Width           =   2415
   End
   Begin VB.DirListBox Dir2
      Height          =   2565
      Left            =   6000
      TabIndex        =   6
      ToolTipText     =   "Select a directory where converted files will be placed."
      Top             =   1680
      Width           =   2415
   End
   Begin VB.FileListBox File2
      Height          =   2625
      Left            =   8640
      Pattern         =   "*.tcw"
      TabIndex        =   5
      Top             =   1680
      Width           =   2415
   End
   Begin VB.FileListBox File1
      Height          =   2625
      Left            =   3000
      MultiSelect     =   2  'Extended
      Pattern         =   "*.tcw"
      TabIndex        =   4
      ToolTipText     =   "A list of files to be converted."
      Top             =   1680
      Width           =   2415
   End
   Begin VB.DirListBox Dir1
      Height          =   2565
      Left            =   360
      TabIndex        =   3
      ToolTipText     =   "Select a directory containing files for conversion."
      Top             =   1680
      Width           =   2415
   End
   Begin VB.DriveListBox Drive1
      Height          =   315
      Left            =   360
      TabIndex        =   2
      Top             =   1080
      Width           =   2415
   End
   Begin VB.CommandButton Close
      Caption         =   "Close"
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   6120
      Width           =   1300
   End
   Begin VB.CommandButton Run
      Caption         =   "Run"
      Height          =   495
      Left            =   3000
      TabIndex        =   0
      ToolTipText     =   "Starts the conversion process."
      Top             =   6120
      Width           =   1300
   End
   Begin VB.Frame Source
      Caption         =   "Source:"
      Height          =   4215
      Left            =   120
      TabIndex        =   8
      Top             =   720
      Width           =   5415
      Begin VB.Label NFiles1
         Height          =   375
         Left            =   3960
         TabIndex        =   12
         Top             =   3720
         Width           =   1215
      End
      Begin VB.Label Label1
         Caption         =   "Total files:"
         Height          =   375
         Left            =   2880
         TabIndex        =   9
         Top             =   3720
         Width           =   855
      End
   End
   Begin VB.Frame Target
      Caption         =   "Destination:"
      Height          =   4215
      Left            =   5760
      TabIndex        =   10
      Top             =   720
      Width           =   5415
      Begin VB.Label NFiles2
         Height          =   375
         Left            =   4080
         TabIndex        =   13
         Top             =   3720
         Width           =   1215
      End
      Begin VB.Label Label2
         Caption         =   "Total files: "
         Height          =   375
         Left            =   2880
         TabIndex        =   11
         Top             =   3720
         Width           =   855
      End
   End
   Begin VB.Label ExportFiltersList
      Caption         =   "Files of type:"
      Height          =   375
      Left            =   5760
      TabIndex        =   16
      Top             =   5280
      Width           =   975
   End
   Begin VB.Label ImportFiltersList
      Caption         =   "Files of type:"
      Height          =   375
      Left            =   120
      TabIndex        =   15
      Top             =   5280
      Width           =   975
   End
   Begin VB.Label Label3
      BorderStyle     =   1  'Fixed Single
      Height          =   375
      Left            =   3000
      TabIndex        =   14
      Top             =   240
      Width           =   8175
   End
End
Attribute VB_Name = "frmConvert"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Close_Click()
    Unload Form1
'    Set Dr = Nothing
    Set Drs = Nothing
    Set objApp = Nothing

End Sub

Private Sub Combo1_LostFocus()
    Timer1.Enabled = False
    File1.Pattern = Left((Right(Combo1.Text, 6)), 5)
    File1.Refresh
    NFiles1.Caption = File1.ListCount

End Sub

Private Sub Combo1_GotFocus()
    CurCombo = True
    Timer1.Enabled = True
    CurImportFilter = Combo1.Text
End Sub
Private Sub Combo2_LostFocus()
    Timer1.Enabled = False
    File2.Pattern = Left((Right(Combo2.Text, 6)), 5)
    File2.Refresh
    NFiles2.Caption = File2.ListCount

End Sub

Private Sub Combo2_GotFocus()
    CurCombo = False
    Timer1.Enabled = True
    CurExportFilter = Combo2.Text

End Sub
Private Sub Dir1_Change()
    File1.FileName = Dir1.Path
    File1.Refresh
    NFiles1.Caption = File1.ListCount

End Sub

Private Sub Dir2_Change()
    File2.FileName = Dir2.Path
    File2.Refresh
    NFiles2.Caption = File2.ListCount

End Sub

Private Sub Drive1_Change()
'    MsgBox Dir1.Path
    Dir1.Path = Drive1.Drive
    Dir1.Refresh
    File1.FileName = Dir1.Path
    File1.Refresh
    NFiles1.Caption = File1.ListCount

End Sub

Private Sub Drive2_Change()
'    MsgBox Dir1.Path
    Dir2.Path = Drive2.Drive
    Dir2.Refresh
    File2.FileName = Dir2.Path
    File2.Refresh
    NFiles2.Caption = File2.ListCount

End Sub

Private Sub Form_Load()
'    Run.Enabled = False
   Dim a As Integer
   Set objApp = CreateObject("IMSIGX.Application")
    If objApp Is Nothing Then
        MsgBox "Could not start server.  " & Err.Description & "  Quitting."
        Exit Sub
    End If
    Set Drs = objApp.Drawings
    If Drs Is Nothing Then
        MsgBox "Bad server.  " & Err.Description & "  Quitting"
        Exit Sub
    End If
''    Exit Sub
    Call Init_FiltersList
End Sub

Private Sub Run_Click()
    On Error GoTo ErrorHandler

    Dim CadFile As String
    Dim CadFileSave As String
    Dim temp As String

    Dim i, b As Integer
    i = 0
    b = File1.ListCount
    If (b = 0) Then
        MsgBox "No .tcw files in source directory"
        Exit Sub
    End If

    While (i < b)

       Label3.Caption = File1.List(i) + " file is being converted"
       Label3.Refresh

       temp = Right(File1.Path, 1)
       If (temp = "\") Then

'           (Right(Combo1.Text, 6))
           CadFile = File1.Path & File1.List(i)

       Else
           CadFile = File1.Path & "\" & File1.List(i)
       End If

       Set Dr = Drs.Open(CadFile)
       temp = Right(File2.Path, 1)

       CadFileSave = Left(File1.List(i), (Len(File1.List(i)) - 4)) ' clip the extesion of the file

       If (temp = "\") Then
           CadFileSave = File2.Path & CadFileSave & Left((Right(Combo2.Text, 5)), 4)
'           CadFileSave = File2.Path & File1.List(i)
       Else

           CadFileSave = File2.Path & "\" & CadFileSave & Left((Right(Combo2.Text, 5)), 4)

'           CadFileSave = File2.Path & "\" & File1.List(i)
       End If

       Dr.SaveAs (CadFileSave)
       Set Dr = Nothing
       i = i + 1
       File2.Refresh
       NFiles2.Caption = File2.ListCount
       NFiles2.Refresh

    Wend
    Label3.Caption = ""
    Label3.Refresh

   MsgBox "Conversion is complete !"
Exit Sub
ErrorHandler:
    MsgBox Err.Description

End Sub
Public Sub Init_FiltersList()
Dim n As Long
Dim Ft As Object 'AddIn
Dim FtName As String
Dim i As Long

i = 0
Set Ftrs = objApp.Filters
n = Ftrs.Count
Combo1.Clear
Combo2.Clear

While (i < n)
    Set Ft = Ftrs.Item(i)
    FtName = Ft.FilterString
    FtName = Left(FtName, (Len(FtName) - 8))
    Combo1.AddItem FtName
    Combo2.AddItem FtName

    i = i + 1
Wend
Combo1.ListIndex = 0
Combo2.ListIndex = 1

File1.Pattern = Left((Right(Combo1.Text, 6)), 5)
File1.Refresh
NFiles1.Caption = File1.ListCount

File2.Pattern = Left((Right(Combo2.Text, 6)), 5)
File2.Refresh
NFiles2.Caption = File2.ListCount

Combo1.Refresh
Combo2.Refresh

End Sub
Private Sub SetupImport_Click()
    MsgBox "Not implemented yet !"
End Sub

Private Sub SetupExport_Click()
      Dim CadFileSave As String

 '          CadFileSave = Left(File1.List(i), (Len(File1.List(i)) - 4)) ' clip the extesion of the file

  '         CadFileSave = File2.Path & CadFileSave & Left((Right(Combo2.Text, 5)), 4)

    MsgBox "Not implemented yet !"

End Sub

Sub Timer1_Timer()
    If (CurCombo = True) Then
        If (CurImportFilter <> Combo1.Text) Then
            File1.Pattern = Left((Right(Combo1.Text, 6)), 5)
            File1.Refresh
            NFiles1.Caption = File1.ListCount
        End If
    Else
        If (CurExportFilter <> Combo2.Text) Then
            File2.Pattern = Left((Right(Combo2.Text, 6)), 5)
            File2.Refresh
            NFiles2.Caption = File2.ListCount
        End If
    End If

End Sub


Examples - File Converter Application - modConverter.bas

modConverter.bas

File Converter Application Example

Attribute VB_Name = "modConvert"
Option Explicit
Global objApp As Object
Global Drs As Object
Global Dr As Object
Global Ftrs As Filters
Global CurCombo As Boolean
Global CurImportFilter As String
Global CurExportFilter As String

Private Sub Form_Load()
    frmConverter.Show 1
End Sub


Examples - Matrix - matrix.frm

matrix.frm

Matrix Example

VERSION 5.00
Begin VB.Form MatrixForm
   Caption         =   "Matrix Object Sample"
   ClientHeight    =   7065
   ClientLeft      =   2370
   ClientTop       =   735
   ClientWidth     =   7350
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7065
   ScaleWidth      =   7350
   Begin VB.CommandButton btExit
      Caption         =   "Exit"
      Height          =   492
      Left            =   120
      TabIndex        =   60
      Top             =   6480
      Width           =   7092
   End
   Begin VB.Frame Frame6
      Appearance      =   0  'Flat
      BackColor       =   &H8000000A&
      Caption         =   "Matrix Transformations :"
      ForeColor       =   &H80000008&
      Height          =   4212
      Left            =   3360
      TabIndex        =   30
      Top             =   2160
      Width           =   3852
      Begin VB.CommandButton btScaleAndRotate
         Caption         =   "TranslateScaleAndRotate"
         Height          =   372
         Left            =   120
         TabIndex        =   58
         ToolTipText     =   "Use Rotate, Scale, Angle, Vertex "
         Top             =   3600
         Width           =   3612
      End
      Begin VB.CommandButton Translate
         Caption         =   "Translate"
         Height          =   372
         Index           =   5
         Left            =   1320
         TabIndex        =   57
         ToolTipText     =   "Use Vertex, Bool flag"
         Top             =   3000
         Width           =   1092
      End
      Begin VB.CommandButton Scale
         Caption         =   "Scale"
         Height          =   372
         Index           =   4
         Left            =   2520
         TabIndex        =   56
         ToolTipText     =   "Use Scale, Vertex, Bool flag"
         Top             =   3000
         Width           =   1212
      End
      Begin VB.CommandButton Rotate
         Caption         =   "Rotate"
         Height          =   372
         Index           =   3
         Left            =   120
         TabIndex        =   55
         ToolTipText     =   "Use Rotate, Angle, Vertex, Bool Flag"
         Top             =   3000
         Width           =   1092
      End
      Begin VB.TextBox valFlag
         Height          =   288
         Left            =   1680
         TabIndex        =   49
         Top             =   2280
         Width           =   612
      End
      Begin VB.TextBox valAngle
         Height          =   288
         Left            =   1680
         TabIndex        =   48
         Top             =   1920
         Width           =   612
      End
      Begin VB.TextBox valRotZ
         Height          =   288
         Left            =   3120
         TabIndex        =   43
         Top             =   1440
         Width           =   612
      End
      Begin VB.TextBox valRotY
         Height          =   288
         Left            =   2400
         TabIndex        =   42
         Top             =   1440
         Width           =   612
      End
      Begin VB.TextBox valRotX
         Height          =   288
         Left            =   1680
         TabIndex        =   41
         Top             =   1440
         Width           =   612
      End
      Begin VB.TextBox valScaleZ
         Height          =   288
         Left            =   3120
         TabIndex        =   40
         Top             =   1080
         Width           =   612
      End
      Begin VB.TextBox valScaleY
         Height          =   288
         Left            =   2400
         TabIndex        =   39
         Top             =   1080
         Width           =   612
      End
      Begin VB.TextBox valScaleX
         Height          =   288
         Left            =   1680
         TabIndex        =   38
         Top             =   1080
         Width           =   612
      End
      Begin VB.TextBox valVertexZ
         Height          =   288
         Left            =   3120
         TabIndex        =   33
         Top             =   720
         Width           =   612
      End
      Begin VB.TextBox valVertexY
         Height          =   288
         Left            =   2400
         TabIndex        =   32
         Top             =   720
         Width           =   612
      End
      Begin VB.TextBox valVertexX
         Height          =   288
         Left            =   1680
         TabIndex        =   31
         Top             =   720
         Width           =   612
      End
      Begin VB.Line Line6
         BorderColor     =   &H80000006&
         X1              =   0
         X2              =   3960
         Y1              =   2760
         Y2              =   2760
      End
      Begin VB.Label Label6
         Caption         =   "Parameters :"
         Height          =   252
         Left            =   120
         TabIndex        =   51
         Top             =   240
         Width           =   1332
      End
      Begin VB.Label Label5
         Caption         =   "Bool flag :"
         Height          =   252
         Left            =   120
         TabIndex        =   50
         Top             =   2280
         Width           =   1332
      End
      Begin VB.Label Label4
         Caption         =   "Angle :"
         Height          =   252
         Left            =   120
         TabIndex        =   47
         Top             =   1920
         Width           =   1332
      End
      Begin VB.Line Line4
         BorderColor     =   &H80000006&
         X1              =   1560
         X2              =   3840
         Y1              =   1800
         Y2              =   1800
      End
      Begin VB.Label Label3
         Caption         =   "Rotate :"
         Height          =   252
         Left            =   120
         TabIndex        =   46
         Top             =   1440
         Width           =   1332
      End
      Begin VB.Label Label2
         Caption         =   "Scale :"
         Height          =   252
         Index           =   1
         Left            =   120
         TabIndex        =   45
         Top             =   1080
         Width           =   1332
      End
      Begin VB.Label Label2
         Caption         =   "Vertex :"
         Height          =   252
         Index           =   0
         Left            =   120
         TabIndex        =   44
         Top             =   720
         Width           =   1332
      End
      Begin VB.Line Line3
         BorderColor     =   &H80000006&
         X1              =   1560
         X2              =   1560
         Y1              =   240
         Y2              =   2760
      End
      Begin VB.Line Line2
         BorderColor     =   &H80000006&
         X1              =   0
         X2              =   3840
         Y1              =   600
         Y2              =   600
      End
      Begin VB.Label Label1
         Alignment       =   2  'Center
         Caption         =   "Z"
         Height          =   252
         Index           =   2
         Left            =   3120
         TabIndex        =   36
         Top             =   240
         Width           =   612
      End
      Begin VB.Label Label1
         Alignment       =   2  'Center
         Caption         =   "Y"
         Height          =   252
         Index           =   1
         Left            =   2400
         TabIndex        =   35
         Top             =   240
         Width           =   612
      End
      Begin VB.Label Label1
         Alignment       =   2  'Center
         Caption         =   "X"
         Height          =   252
         Index           =   0
         Left            =   1680
         TabIndex        =   34
         Top             =   240
         Width           =   612
      End
   End
   Begin VB.Frame Frame5
      Appearance      =   0  'Flat
      BackColor       =   &H8000000A&
      Caption         =   "Matrix's set"
      ForeColor       =   &H80000008&
      Height          =   4212
      Left            =   120
      TabIndex        =   11
      Top             =   2160
      Width           =   3012
      Begin VB.CommandButton Transpose
         Caption         =   "Transpose"
         Height          =   372
         Index           =   0
         Left            =   120
         TabIndex        =   54
         Top             =   3720
         Width           =   2772
      End
      Begin VB.CommandButton Invert
         Caption         =   "Invert"
         Height          =   372
         Index           =   0
         Left            =   1560
         TabIndex        =   53
         Top             =   3240
         Width           =   1332
      End
      Begin VB.CommandButton Identity
         Caption         =   "Identity"
         Height          =   372
         Index           =   1
         Left            =   120
         TabIndex        =   52
         Top             =   3240
         Width           =   1332
      End
      Begin VB.ComboBox cbMatrix
         Height          =   288
         Left            =   120
         TabIndex        =   37
         Top             =   2280
         Width           =   2772
      End
      Begin VB.CommandButton btSet
         Caption         =   "Set"
         Height          =   372
         Left            =   120
         TabIndex        =   29
         Top             =   2760
         Width           =   1332
      End
      Begin VB.CommandButton btGet
         Caption         =   "Get"
         Height          =   372
         Left            =   1560
         TabIndex        =   28
         Top             =   2760
         Width           =   1332
      End
      Begin VB.TextBox matrix_33
         Height          =   288
         Left            =   2280
         TabIndex        =   27
         Top             =   1800
         Width           =   612
      End
      Begin VB.TextBox matrix_32
         Height          =   288
         Left            =   1560
         TabIndex        =   26
         Top             =   1800
         Width           =   612
      End
      Begin VB.TextBox matrix_31
         Height          =   288
         Left            =   840
         TabIndex        =   25
         Top             =   1800
         Width           =   612
      End
      Begin VB.TextBox matrix_30
         Height          =   288
         Left            =   120
         TabIndex        =   24
         Top             =   1800
         Width           =   612
      End
      Begin VB.TextBox matrix_23
         Height          =   288
         Left            =   2280
         TabIndex        =   23
         Top             =   1440
         Width           =   612
      End
      Begin VB.TextBox matrix_22
         Height          =   288
         Left            =   1560
         TabIndex        =   22
         Top             =   1440
         Width           =   612
      End
      Begin VB.TextBox matrix_21
         Height          =   288
         Left            =   840
         TabIndex        =   21
         Top             =   1440
         Width           =   612
      End
      Begin VB.TextBox matrix_20
         Height          =   288
         Left            =   120
         TabIndex        =   20
         Top             =   1440
         Width           =   612
      End
      Begin VB.TextBox matrix_13
         Height          =   288
         Left            =   2280
         TabIndex        =   19
         Top             =   1080
         Width           =   612
      End
      Begin VB.TextBox matrix_12
         Height          =   288
         Left            =   1560
         TabIndex        =   18
         Top             =   1080
         Width           =   612
      End
      Begin VB.TextBox matrix_11
         Height          =   288
         Left            =   840
         TabIndex        =   17
         Top             =   1080
         Width           =   612
      End
      Begin VB.TextBox matrix_10
         Height          =   288
         Left            =   120
         TabIndex        =   16
         Top             =   1080
         Width           =   612
      End
      Begin VB.TextBox matrix_03
         Height          =   288
         Left            =   2280
         TabIndex        =   15
         Top             =   720
         Width           =   612
      End
      Begin VB.TextBox matrix_02
         Height          =   288
         Left            =   1560
         TabIndex        =   14
         Top             =   720
         Width           =   612
      End
      Begin VB.TextBox matrix_01
         Height          =   288
         Left            =   840
         TabIndex        =   13
         Top             =   720
         Width           =   612
      End
      Begin VB.TextBox matrix_00
         Height          =   288
         Left            =   120
         TabIndex        =   12
         Top             =   720
         Width           =   612
      End
      Begin VB.Line Line8
         BorderColor     =   &H80000006&
         X1              =   3000
         X2              =   0
         Y1              =   600
         Y2              =   600
      End
      Begin VB.Label Label7
         Alignment       =   2  'Center
         Caption         =   "Contents :"
         Height          =   252
         Left            =   840
         TabIndex        =   59
         Top             =   240
         Width           =   1332
      End
      Begin VB.Line Line1
         BorderColor     =   &H80000006&
         X1              =   0
         X2              =   3000
         Y1              =   2160
         Y2              =   2160
      End
   End
   Begin VB.Frame Frame3
      Appearance      =   0  'Flat
      BackColor       =   &H8000000A&
      Caption         =   "Create :"
      ClipControls    =   0   'False
      ForeColor       =   &H80000008&
      Height          =   1932
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   7092
      Begin VB.Frame Frame2
         Appearance      =   0  'Flat
         BackColor       =   &H8000000A&
         Caption         =   "Command :"
         ForeColor       =   &H80000008&
         Height          =   1332
         Left            =   3240
         TabIndex        =   3
         Top             =   360
         Width           =   3732
         Begin VB.CommandButton btDuplicate
            Caption         =   "Duplicate"
            Enabled         =   0   'False
            Height          =   372
            Left            =   1320
            TabIndex        =   10
            Top             =   480
            Width           =   1092
         End
         Begin VB.CommandButton btDelete
            Caption         =   "Delete"
            Enabled         =   0   'False
            Height          =   372
            Left            =   2520
            TabIndex        =   9
            Top             =   480
            Width           =   1092
         End
         Begin VB.CommandButton btCreate
            Caption         =   "Create"
            Height          =   372
            Left            =   120
            TabIndex        =   8
            Top             =   480
            Width           =   1092
         End
      End
      Begin VB.Frame Frame1
         Appearance      =   0  'Flat
         BackColor       =   &H8000000A&
         Caption         =   "Server mode :"
         ForeColor       =   &H80000008&
         Height          =   1332
         Left            =   1560
         TabIndex        =   2
         Top             =   360
         Width           =   1452
         Begin VB.OptionButton optLocal
            Caption         =   "Local"
            Height          =   252
            Left            =   120
            TabIndex        =   7
            Top             =   840
            Width           =   852
         End
         Begin VB.OptionButton optInproc
            Caption         =   "In-proc"
            Height          =   252
            Left            =   120
            TabIndex        =   6
            Top             =   360
            Value           =   -1  'True
            Width           =   852
         End
      End
      Begin VB.Frame Frame4
         Appearance      =   0  'Flat
         BackColor       =   &H8000000A&
         Caption         =   "Object :"
         ClipControls    =   0   'False
         ForeColor       =   &H80000008&
         Height          =   1332
         Left            =   120
         TabIndex        =   1
         Top             =   360
         Width           =   1335
         Begin VB.OptionButton optVertex
            Caption         =   "Vertex"
            Height          =   252
            Left            =   120
            TabIndex        =   5
            Top             =   840
            Width           =   975
         End
         Begin VB.OptionButton optMatrix
            Caption         =   "Matrix"
            Height          =   252
            Left            =   120
            TabIndex        =   4
            Top             =   360
            Value           =   -1  'True
            Width           =   732
         End
      End
   End
   Begin VB.Line Line7
      X1              =   120
      X2              =   3120
      Y1              =   2760
      Y2              =   2760
   End
   Begin VB.Line Line5
      X1              =   3360
      X2              =   7200
      Y1              =   2520
      Y2              =   2520
   End
End
Attribute VB_Name = "MatrixForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim bObject As Boolean
Dim bMode As Boolean

Dim objVertex As Object

Dim objarrMatrix(99) As Object
Dim indMatrix As Long
Dim varMatrix As Variant
Dim dblMatrix(3, 3) As Double

Private Sub btCreate_Click()
    Dim strMatrix As String
    On Error GoTo ErrorHandler
    If (bObject = True) Then
        indMatrix = indMatrix + 1
        If (bMode = True) Then
            strMatrix = "In-proc matrix"
            Set objarrMatrix(indMatrix) = CreateObject("IMSIGX.Matrix.4")
        Else
            strMatrix = "Local matrix"
            Set objarrMatrix(indMatrix) = CreateObject("TurboCad.Matrix.4")
        End If
           strMatrix = strMatrix + Str(indMatrix)
           cbMatrix.AddItem strMatrix
           cbMatrix.Text = cbMatrix.List(indMatrix)

            btDuplicate.Enabled = True
    Else
        If (bMode = True) Then
            Set objVertex = CreateObject("IMSIGX.Vertex.4")
        Else
            Set objVertex = CreateObject("TurboCad.Vertex.4")
        End If
        btCreate.Enabled = False
        btDuplicate.Enabled = False
        btDelete.Enabled = True
    End If
    Exit Sub
ErrorHandler:
    MsgBox Error(Err.Number)
End Sub

Private Sub btDelete_Click()
    On Error GoTo ErrorHandler
    If (bObject = False) Then
        objVertex.Delete
        btDelete.Enabled = False
        btCreate.Enabled = True
    Else
        If (ind < atrix >= 0) Then
            objarrMatrix(indMatrix).Delete
            If (indMatrix > cbMatrix.ListCount) Then
                indMatrix = indMatrix - 1
            End If
        End If
    End If
    Exit Sub
ErrorHandler:
    MsgBox Error(Err.Number)
End Sub

Private Sub btDuplicate_Click()
    Dim indNewMatrix As Long
    Dim strMatrix As String
    On Error GoTo ErrorHandler
    If (bObject = True) Then
        indNewMatrix = cbMatrix.ListCount
        If (indMatrix > 99) Then
            Error 9
        Else
            Set objarrMatrix(indNewMatrix) = objarrMatrix(indMatrix).Duplicate
            strMatrix = cbMatrix.Text + Str(indNewMatrix)
            cbMatrix.AddItem strMatrix
            cbMatrix.Text = cbMatrix.List(indNewMatrix)
        End If
    Else
        MsgBox "Don't duplicate Vertex !"
    End If
    Exit Sub
ErrorHandler:
    MsgBox Error(Err.Number)
End Sub

Private Sub btExit_Click()
    On Error Resume Next
    objVertex.Delete
    End
End Sub

Private Sub btGet_Click()
    Dim i As Integer
    Dim j As Integer

    On Error GoTo ErrorHandler
    If (indMatrix < 0) Then Error 424

    For i = 0 To 3 Step 1
        For j = 0 To 3 Step 1
            dblMatrix(i, j) = 0
        Next j
    Next i

    varMatrix = dblMatrix
    objarrMatrix(indMatrix).GetArray varMatrix

    matrix_00.Text = varMatrix(0, 0)
    matrix_01.Text = varMatrix(0, 1)
    matrix_02.Text = varMatrix(0, 2)
    matrix_03.Text = varMatrix(0, 3)

    matrix_10.Text = varMatrix(1, 0)
    matrix_11.Text = varMatrix(1, 1)
    matrix_12.Text = varMatrix(1, 2)
    matrix_13.Text = varMatrix(1, 3)

    matrix_20.Text = varMatrix(2, 0)
    matrix_21.Text = varMatrix(2, 1)
    matrix_22.Text = varMatrix(2, 2)
    matrix_23.Text = varMatrix(2, 3)

    matrix_30.Text = varMatrix(3, 0)
    matrix_31.Text = varMatrix(3, 1)
    matrix_32.Text = varMatrix(3, 2)
    matrix_33.Text = varMatrix(3, 3)

    Exit Sub

ErrorHandler:
    MsgBox Error(Err.Number)

End Sub

Private Sub btScaleAndRotate_Click()

    Dim X As Double
    Dim Y As Double
    Dim Z As Double

    Dim XScale As Double
    Dim YScale As Double
    Dim ZScale As Double

    Dim Angle As Double

    Dim varVertex As Variant

    On Error GoTo ErrorHandler
    If (indMatrix < 0) Then Error 424

    X = Val(valVertexX.Text)
    Y = Val(valVertexY.Text)
    Z = Val(valVertexZ.Text)

    objVertex.X = X
    objVertex.Y = Y
    objVertex.Z = Z

    Set varVertex = objVertex

    XScale = Val(valScaleX.Text)
    YScale = Val(valScaleY.Text)
    ZScale = Val(valScaleZ.Text)

    X = Val(valRotX.Text)
    Y = Val(valRotY.Text)
    Z = Val(valRotZ.Text)

    Angle = Val(valAngle.Text)

    objarrMatrix(indMatrix).TranslateScaleAndRotateZ X, Y, Z, XScale, YScale, ZScale, Angle, varVertex
    Exit Sub
ErrorHandler:
    MsgBox Error(Err.Number)
End Sub

Private Sub btSet_Click()
    On Error GoTo ErrorHandler
    If (indMatrix < 0) Then Error 424

    dblMatrix(0, 0) = Val(matrix_00.Text)
    dblMatrix(0, 1) = Val(matrix_01.Text)
    dblMatrix(0, 2) = Val(matrix_02.Text)
    dblMatrix(0, 3) = Val(matrix_03.Text)

    dblMatrix(1, 0) = Val(matrix_10.Text)
    dblMatrix(1, 1) = Val(matrix_11.Text)
    dblMatrix(1, 2) = Val(matrix_12.Text)
    dblMatrix(1, 3) = Val(matrix_13.Text)

    dblMatrix(2, 0) = Val(matrix_20.Text)
    dblMatrix(2, 1) = Val(matrix_21.Text)
    dblMatrix(2, 2) = Val(matrix_22.Text)
    dblMatrix(2, 3) = Val(matrix_23.Text)

    dblMatrix(3, 0) = Val(matrix_30.Text)
    dblMatrix(3, 1) = Val(matrix_31.Text)
    dblMatrix(3, 2) = Val(matrix_32.Text)
    dblMatrix(3, 3) = Val(matrix_33.Text)

    varMatrix = dblMatrix
    objarrMatrix(indMatrix).SetArray varMatrix
    Exit Sub
ErrorHandler:
    MsgBox Error(Err.Number)

End Sub

Private Sub cbMatrix_Click()
    indMatrix = cbMatrix.ListIndex
End Sub

Private Sub Form_Load()
    bObject = True
    bMode = True
    indMatrix = -1
End Sub

Private Sub Identity_Click(Index As Integer)
    On Error GoTo ErrorHandler
    If (indMatrix < 0) Then Error 424

    objarrMatrix(indMatrix).Identity
    Exit Sub
ErrorHandler:
    MsgBox Error(Err.Number)
End Sub

Private Sub Invert_Click(Index As Integer)
    On Error GoTo ErrorHandler
    If (indMatrix < 0) Then Error 424

    objarrMatrix(indMatrix).Invert
    Exit Sub
ErrorHandler:
    MsgBox Error(Err.Number)
End Sub

Private Sub optInproc_Click()
    bMode = True 'In-proc server
    optLocal.Value = False
End Sub

Private Sub optLocal_Click()
    bMode = False 'Local server
    optInproc.Value = False
End Sub

Private Sub optMatrix_Click()
    bObject = True ' Create matrix object
    optVertex.Value = False

    btCreate.Enabled = True
    btDelete.Enabled = False

    If (indMatrix >= 0) Then
        btDuplicate.Enabled = True
    Else
        btDuplicate.Enabled = False
    End If

End Sub

Private Sub optVertex_Click()
    Dim hVertex As Long
    bObject = False 'Create vertex object
    optMatrix.Value = False

    btDuplicate.Enabled = False

    On Error GoTo ErrorHandler
    hVertex = objVertex.GetHandle()

VertexExist:
    btCreate.Enabled = False
    btDelete.Enabled = True
    Exit Sub

ErrorHandler:
    If (Err.Number <> 438) Then
        btDelete.Enabled = False
        btCreate.Enabled = True
    Else
        GoTo VertexExist
    End If
End Sub

Private Sub Rotate_Click(Index As Integer)

    Dim X As Double
    Dim Y As Double
    Dim Z As Double

    Dim Angle As Double

    Dim varConcat As Variant
    Dim varVertex As Variant

    Dim bConcat As Boolean

    On Error GoTo ErrorHandler
    If (indMatrix < 0) Then Error 424

    X = Val(valVertexX.Text)
    Y = Val(valVertexY.Text)
    Z = Val(valVertexZ.Text)

    objVertex.X = X
    objVertex.Y = Y
    objVertex.Z = Z

    Set varVertex = objVertex

    X = Val(valRotX.Text)
    Y = Val(valRotY.Text)
    Z = Val(valRotZ.Text)

    Angle = Val(valAngle.Text)

    bConcat = Val(valFlag)
    varConcat = bConcat

    objarrMatrix(indMatrix).Rotate X, Y, Z, Angle, varVertex, varConcat
    Exit Sub

ErrorHandler:
    MsgBox Error(Err.Number)
End Sub

Private Sub Scale_Click(Index As Integer)
    Dim hResult As Long
    Dim X As Double
    Dim Y As Double
    Dim Z As Double

    Dim varConcat As Variant
    Dim varVertex As Variant

    Dim bConcat As Boolean

    On Error GoTo ErrorHandler
    If (indMatrix < 0) Then Error 424

    X = Val(valVertexX.Text)
    Y = Val(valVertexY.Text)
    Z = Val(valVertexZ.Text)

    objVertex.X = X
    objVertex.Y = Y
    objVertex.Z = Z

    Set varVertex = objVertex

    X = Val(valScaleX.Text)
    Y = Val(valScaleY.Text)
    Z = Val(valScaleZ.Text)

    bConcat = Val(valFlag)
    varConcat = bConcat

    hResult = objarrMatrix(indMatrix).Scale(X, Y, Z, varVertex, varConcat)
    Exit Sub
ErrorHandler:
    MsgBox Error(Err.Number)
End Sub

Private Sub Translate_Click(Index As Integer)
    Dim X As Double
    Dim Y As Double
    Dim Z As Double

    Dim varConcat As Variant
    Dim varVetrex As Variant

    Dim bConcat As Boolean

    On Error GoTo ErrorHandler
    If (indMatrix < 0) Then Error 424

    X = Val(valVertexX.Text)
    Y = Val(valVertexY.Text)
    Z = Val(valVertexZ.Text)

    bConcat = Val(valFlag)
    varConcat = bConcat

    objarrMatrix(indMatrix).Translate X, Y, Z, varConcat
    Exit Sub
ErrorHandler:
    MsgBox Error(Err.Number)

End Sub

Private Sub Transpose_Click(Index As Integer)
    On Error GoTo ErrorHandler
    If (indMatrix < 0) Then Error 424

    objarrMatrix(indMatrix).Transpose
    Exit Sub
ErrorHandler:
    MsgBox Error(Err.Number)
End Sub


Examples - Preview - Preview.Frm

Preview.Frm

Preview Example

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "comdlg32.ocx"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
Begin VB.Form frmPreview
   Caption         =   "TurboCAD SDK Demo"
   ClientHeight    =   6840
   ClientLeft      =   3570
   ClientTop       =   1215
   ClientWidth     =   8490
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6840
   ScaleWidth      =   8490
   Begin ComctlLib.Toolbar Toolbar1
      Align           =   1  'Align Top
      Height          =   465
      Left            =   0
      TabIndex        =   11
      Top             =   0
      Width           =   8490
      _ExtentX        =   14975
      _ExtentY        =   820
      ButtonWidth     =   741
      ButtonHeight    =   714
      AllowCustomize  =   0   'False
      ImageList       =   "ImageList1"
      _Version        =   327682
      BeginProperty Buttons {0713E452-850A-101B-AFC0-4210102A8DA7}
         NumButtons      =   6
         BeginProperty Button1 {0713F354-850A-101B-AFC0-4210102A8DA7}
            Caption         =   ""
            Key             =   "Circle"
            Description     =   ""
            Object.ToolTipText     =   "Add Circle"
            Object.Tag             =   ""
            ImageIndex      =   1
            Style           =   2
         EndProperty
         BeginProperty Button2 {0713F354-850A-101B-AFC0-4210102A8DA7}
            Caption         =   ""
            Key             =   "Line"
            Description     =   ""
            Object.ToolTipText     =   "Add Line"
            Object.Tag             =   ""
            ImageIndex      =   2
            Style           =   2
         EndProperty
         BeginProperty Button3 {0713F354-850A-101B-AFC0-4210102A8DA7}
            Caption         =   ""
            Key             =   "Curve"
            Description     =   ""
            Object.ToolTipText     =   "Add Curve"
            Object.Tag             =   ""
            ImageIndex      =   3
            Style           =   2
         EndProperty
         BeginProperty Button4 {0713F354-850A-101B-AFC0-4210102A8DA7}
            Caption         =   ""
            Key             =   "Star"
            Description     =   ""
            Object.ToolTipText     =   "Add Star"
            Object.Tag             =   ""
            ImageIndex      =   4
            Style           =   2
         EndProperty
         BeginProperty Button5 {0713F354-850A-101B-AFC0-4210102A8DA7}
            Caption         =   ""
            Key             =   ""
            Description     =   ""
            Object.ToolTipText     =   ""
            Object.Tag             =   ""
            Style           =   3
         EndProperty
         BeginProperty Button6 {0713F354-850A-101B-AFC0-4210102A8DA7}
            Caption         =   ""
            Key             =   "Select"
            Description     =   ""
            Object.ToolTipText     =   "Select"
            Object.Tag             =   ""
            ImageIndex      =   5
            Style           =   2
         EndProperty
      EndProperty
   End
   Begin VB.CommandButton cmdDraw
      Caption         =   "Draw"
      Height          =   375
      Left            =   120
      TabIndex        =   10
      Top             =   600
      Width           =   855
   End
   Begin VB.PictureBox Picture1
      Height          =   4695
      Left            =   120
      ScaleHeight     =   309
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   533
      TabIndex        =   9
      Top             =   1560
      Width           =   8055
   End
   Begin VB.VScrollBar VScroll1
      Height          =   4695
      LargeChange     =   4000
      Left            =   8160
      Max             =   32000
      SmallChange     =   1000
      TabIndex        =   8
      Top             =   1560
      Width           =   255
   End
   Begin VB.HScrollBar HScroll1
      Height          =   255
      LargeChange     =   4000
      Left            =   120
      Max             =   32000
      SmallChange     =   1000
      TabIndex        =   7
      Top             =   6240
      Width           =   8055
   End
   Begin VB.ComboBox Combo1
      Height          =   315
      Left            =   4560
      TabIndex        =   5
      Top             =   600
      Width           =   3855
   End
   Begin VB.CommandButton cmdProperties
      Caption         =   "Properties"
      Height          =   375
      Left            =   1080
      TabIndex        =   4
      Top             =   600
      Width           =   855
   End
   Begin VB.CommandButton cmdNew
      Caption         =   "New Drawing"
      Height          =   375
      Left            =   3240
      TabIndex        =   3
      Top             =   1080
      Width           =   1215
   End
   Begin VB.CommandButton cmdZoomPlus
      Caption         =   "Zoom In"
      Height          =   375
      Left            =   1080
      TabIndex        =   2
      Top             =   1080
      Width           =   855
   End
   Begin VB.CommandButton cmdZoomMinus
      Caption         =   "Zoom Out"
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   1080
      Width           =   855
   End
   Begin VB.CommandButton cmdOpen
      Caption         =   "Open Drawing"
      Height          =   375
      Left            =   3240
      TabIndex        =   0
      Top             =   600
      Width           =   1215
   End
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   4800
      Top             =   960
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
      Filter          =   "TurboCAD Files (*.tcw)|*.tcw"
   End
   Begin ComctlLib.StatusBar StatusBar1
      Align           =   2  'Align Bottom
      Height          =   300
      Left            =   0
      TabIndex        =   6
      Top             =   6540
      Width           =   8490
      _ExtentX        =   14975
      _ExtentY        =   529
      SimpleText      =   ""
      _Version        =   327682
      BeginProperty Panels {0713E89E-850A-101B-AFC0-4210102A8DA7}
         NumPanels       =   5
         BeginProperty Panel1 {0713E89F-850A-101B-AFC0-4210102A8DA7}
            AutoSize        =   1
            Object.Width           =   9287
            Text            =   "No drawing"
            TextSave        =   "No drawing"
            Key             =   ""
            Object.Tag             =   ""
         EndProperty
         BeginProperty Panel2 {0713E89F-850A-101B-AFC0-4210102A8DA7}
            Object.Width           =   1270
            MinWidth        =   1270
            Text            =   "Left"
            TextSave        =   "Left"
            Key             =   ""
            Object.Tag             =   ""
         EndProperty
         BeginProperty Panel3 {0713E89F-850A-101B-AFC0-4210102A8DA7}
            Object.Width           =   1270
            MinWidth        =   1270
            Text            =   "Top"
            TextSave        =   "Top"
            Key             =   ""
            Object.Tag             =   ""
         EndProperty
         BeginProperty Panel4 {0713E89F-850A-101B-AFC0-4210102A8DA7}
            Object.Width           =   1270
            MinWidth        =   1270
            Text            =   "Width"
            TextSave        =   "Width"
            Key             =   ""
            Object.Tag             =   ""
         EndProperty
         BeginProperty Panel5 {0713E89F-850A-101B-AFC0-4210102A8DA7}
            Object.Width           =   1270
            MinWidth        =   1270
            Text            =   "Height"
            TextSave        =   "Height"
            Key             =   ""
            Object.Tag             =   ""
         EndProperty
      EndProperty
   End
   Begin ComctlLib.ImageList ImageList1
      Left            =   5400
      Top             =   960
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   21
      ImageHeight     =   21
      MaskColor       =   12632256
      _Version        =   327682
      BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
         NumListImages   =   5
         BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
            Picture         =   "Preview.frx":0000
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
            Picture         =   "Preview.frx":018E
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
            Picture         =   "Preview.frx":031C
            Key             =   ""
         EndProperty
         BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
            Picture         =   "Preview.frx":04AA
            Key             =   ""
         EndProperty
         BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
            Picture         =   "Preview.frx":0A3C
            Key             =   ""
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "frmPreview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'Global variables
'SDK objects
Dim TheApp As Object
Dim Drawings As Object
Dim TheDrawing As Object
Dim Views As Object
Dim TheView As Object

'View parameters
Dim ViewH#, ViewW#, ViewL#, ViewT# 'View coordinates

'Scroll parameters
Dim ScrollCenterX#, ScrollCenterY# 'Dead center for scrolling
Dim ScrollRangeX#, ScrollRangeY# 'Scroll range
Dim HScrollLast%, VScrollLast% 'Remember last values for use in scrolling

'Drag and tool states
Dim ActiveTool$
Dim StartX#, StartY#
Dim LeftButtonDown As Boolean
Dim Dragging As Boolean

'Curve tool
Dim SplineGraphic As Object
Dim SplineVerts As Object

'Select tool
Dim SelectedGraphic As Object
Dim SavedColor As Variant

Private Sub OnNewDrawing()
  On Error GoTo Errors
  'Update the status bar with new drawing name
  StatusBar1.Panels(1).Text = TheDrawing.Name
  Picture1.BackColor = RGB(255, 255, 255)
  Set Views = TheDrawing.Views
  Set TheView = Views.Add
  ViewW# = 0
  ViewH# = 0
  ViewL# = 0
  ViewT# = 0
  ViewZoomBy 0
  Exit Sub
Errors:
  ReleaseDrawingObjects
End Sub

Private Sub cmdDraw_Click()
    Repaint
End Sub

'New button handler
Private Sub cmdNew_Click()
    ReleaseDrawingObjects 'Close old drawing, etc.
    Set TheDrawing = Drawings.Add
    OnNewDrawing
End Sub

'Open button handler
Private Sub cmdOpen_Click()
    Dim FileName$
    CommonDialog1.ShowOpen 'Get .tcw file name
    FileName$ = CommonDialog1.FileName
    If FileName$ = "" Then Exit Sub
    'Set wait cursor
    ReleaseDrawingObjects 'Close old drawing, etc.
    Set TheDrawing = Drawings.Open(FileName$)
    OnNewDrawing
End Sub

Private Sub cmdZoomMinus_Click()
    ViewZoomBy 0.707
End Sub

Private Sub cmdZoomPlus_Click()
    ViewZoomBy 1.414
End Sub

Private Sub Form_Load()
    On Error Resume Next 'Hide exceptions

    'Connect to application server
    'Use IMSIGX.Application.4 for inproc (DLL) server
    'Use TurboCAD.Application.4 for local (EXE) server
    Set TheApp = CreateObject("IMSIGX.Application.4")
    If TheApp Is Nothing Then
        MsgBox "Could not start server.  " & Err.Description & "  Quitting."
        End
    Else
        Set Drawings = TheApp.Drawings
        If Drawings Is Nothing Then
            MsgBox "Bad server.  " & Err.Description & "  Quitting"
            End
        End If
    End If
End Sub

Private Function UnselectAll() As Boolean
    Dim PenColor As Object
    If Not (SelectedGraphic Is Nothing) Then
        Set PenColor = SelectedGraphic.Properties("PenColor")
        PenColor.Value = SavedColor
        Set SelectedGraphic = Nothing
        UnselectAll = True
    Else
        UnselectAll = False
    End If
End Function

Public Sub KillModes()
    If ActiveTool$ <> "" Then
        Toolbar1.Buttons(ActiveTool$).Value = tbrUnpressed
        ActiveTool$ = ""
    End If
    If UnselectAll Then Repaint
    Set SplineVerts = Nothing
    Set SplineGraphic = Nothing
    LeftButtonDown = False
    Dragging = False
End Sub

Public Sub ReleaseDrawingObjects()
    KillModes
    'Update the status bar
    StatusBar1.Panels(1).Text = "No drawing"
    Set TheView = Nothing
    Set Views = Nothing
    Picture1.BackColor = vbWindowBackground
    If Not (TheDrawing Is Nothing) Then
        TheDrawing.Close
        Set TheDrawing = Nothing
    End If
End Sub

'Painting
Private Sub Repaint()
    Picture1.Refresh
End Sub

'Zooming
Private Sub ViewZoomBy(Factor#)
    TheView.Update = False
    TheView.hWnd = Picture1.hWnd
    TheView.MappingMode = 1
    TheView.Margins = False
    TheView.FixedAspectRatio = True

    Dim ViewChanged As Boolean
    Dim ZoomIt As Boolean
    If Factor# <= 0# Or (ViewW# = 0 And ViewW# = 0) Then
        'Factor# <= 0# means reset.  Otherwise, initial settings
        TheView.ScreenLeft = Picture1.ScaleLeft
        TheView.ScreenTop = Picture1.ScaleTop
        TheView.ScreenWidth = Picture1.ScaleWidth
        TheView.ScreenHeight = Picture1.ScaleHeight
        'TheView.ZoomToExtents
        ViewL# = TheView.ViewLeft
        ViewT# = TheView.ViewTop
        ViewW# = TheView.ViewWidth
        ViewH# = TheView.ViewHeight
        ZoomIt = True
        ViewChanged = True
    End If
    If Factor# > 0# And Factor <> 1# Then
        'Keep the center fixed, and change the view coordinates
        Dim ViewCenterX#, ViewCenterY#
        ViewCenterX# = ViewL# + (ViewW# / 2#)
        ViewCenterY# = ViewT# - (ViewH# / 2#)
        ViewW# = ViewW# / Factor#
        ViewH# = ViewH# / Factor#
        ViewL# = ViewCenterX# - (ViewW# / 2#)
        ViewT# = ViewCenterY# + (ViewH# / 2#)
        ViewChanged = True
    End If
    'Synchronize the view
    TheView.ViewLeft = ViewL#
    TheView.ViewTop = ViewT#
    TheView.ViewWidth = ViewW#
    TheView.ViewHeight = ViewH#
    If ZoomIt Then
        TheView.ZoomToExtents
    End If
    Repaint 'Update display
    If ViewChanged Then
        UpdateScrollParams
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    ReleaseDrawingObjects
    Set Drawings = Nothing
    Set TheApp = Nothing
End Sub

'Scrolling
Private Sub UpdateScrollParams()
    'Min always 0
    'Max always 32000
    'LargeChange always 320
    'SmallChange always 32

    'Default values
    ScrollCenterX# = 0#
    ScrollCenterY# = 0#
    ScrollRangeX# = 1#
    ScrollRangeY# = 1#

    Dim X1#, Y1#, X2#, Y2#
    X1# = ViewL#
    Y1# = ViewT# - ViewH#
    X2# = ViewL# + ViewW#
    Y2# = ViewT#

    On Error GoTo Errors
    If Not (TheDrawing Is Nothing) Then
        'Set scroll center to center of drawing's
        'X-Y bounding box
        Dim Graphics As Object
        Dim BBox As Object
        Dim BoxMin As Object
        Dim BoxMax As Object
        Set Graphics = TheDrawing.Graphics
        Set BBox = Graphics.CalcBoundingBox
        Set BoxMin = BBox.Min
        Set BoxMax = BBox.Max
        X1# = BoxMin.X
        Y1# = BoxMin.Y
        X2# = BoxMax.X
        Y2# = BoxMax.Y
        ScrollCenterX# = (X1# + X2#) / 2#
        ScrollCenterY# = (Y1# + Y2#) / 2#

        'Expand bounding box to include current viewport
        If ViewL# < X1# Then X1# = ViewL#
        If (ViewT# - ViewH#) < Y1# Then Y1# = ViewT# - ViewH#
        If (ViewL# + ViewW#) > X2# Then X2# = ViewL# + ViewW#
        If ViewT# > Y2# Then Y2# = ViewT#
    End If

Errors:
    'Now set scroll range based on bounding box
    Dim Delta1#, Delta2# 'Either side of center
    Delta1# = ScrollCenterX# - X1#
    Delta2# = X2# - ScrollCenterX#
    If Delta1# > Delta2# Then
        ScrollRangeX# = 2# * Delta1#
    Else
        ScrollRangeX# = 2# * Delta2#
    End If
    Delta1# = ScrollCenterY# - Y1#
    Delta2# = Y2# - ScrollCenterY#
    If Delta1# > Delta2# Then
        ScrollRangeY# = 2# * Delta1#
    Else
        ScrollRangeY# = 2# * Delta2#
    End If

    'Update controls with these values
    SetScrollValues
End Sub

'Update HScroll1 and VScroll1 controls with global values
Private Sub SetScrollValues()
    Dim ScrollVal%
    Dim DValue#, DMax# 'Scrollbar value, max as doubles
    Dim ViewC# 'Center of view

    'We set the values proportionally
    If ScrollRangeX# > 0# Then
        DMax# = HScroll1.Max
        ViewC# = ViewL# + (ViewW# / 2#)
        DValue# = (DMax# / 2#) + DMax# * (ViewC# - ScrollCenterX#) / ScrollRangeX#
        If DValue# < 0# Then
            ScrollVal% = 0
        ElseIf DValue# > DMax# Then
            ScrollVal% = HScroll1.Max
        Else
            ScrollVal% = DValue#
        End If
    Else
        ScrollVal% = (HScroll1.Min + HScroll1.Max) / 2
    End If
    HScroll1.Value = ScrollVal%
    HScrollLast% = ScrollVal% 'Remember last value
    If ScrollRangeY# > 0# Then
        DMax# = VScroll1.Max
        ViewC# = ViewT# - (ViewH# / 2#)
        DValue# = (DMax# / 2#) + DMax# * (ViewC# - ScrollCenterY#) / ScrollRangeY#
        If DValue# < 0# Then
            ScrollVal% = 0
        ElseIf DValue# > DMax# Then
            ScrollVal% = VScroll1.Max
        Else
            ScrollVal% = DValue#
        End If
    Else
        ScrollVal% = (VScroll1.Min + VScroll1.Max) / 2
    End If
    VScroll1.Value = ScrollVal%
    VScrollLast% = ScrollVal% 'Remember last value
End Sub

'Change the viewport parameters after a scroll
Private Sub ViewScrollBy(DeltaX#, DeltaY#)
    ViewL# = ViewL# + DeltaX#
    ViewT# = ViewT# + DeltaY#
    ViewZoomBy 1#
End Sub

Private Sub UpdateHScroll()
    Dim ScrollVal%
    ScrollVal% = HScroll1.Value
    If (ScrollVal% <> HScrollLast%) And Not (TheDrawing Is Nothing Or TheView Is Nothing) Then
        Dim Range#
        Dim Delta#
        Range# = HScroll1.Max - HScroll1.Min
        Delta# = ScrollVal% - HScrollLast%
        Delta# = Delta# * ViewW# / Range#
        ViewScrollBy Delta#, 0#
    End If
    HScrollLast% = ScrollVal% 'Remember last value
End Sub

Private Sub UpdateVScroll()
    Dim ScrollVal%
    ScrollVal% = VScroll1.Value
    If (ScrollVal% <> VScrollLast%) And Not (TheDrawing Is Nothing Or TheView Is Nothing) Then
        Dim Range#
        Dim Delta#
        Range# = VScroll1.Max - VScroll1.Min
        Delta# = ScrollVal% - VScrollLast%
        Delta# = -Delta# * ViewH# / Range#
        ViewScrollBy 0#, Delta#
    End If
    VScrollLast% = ScrollVal% 'Remember last value
End Sub

'Scroll handlers
Private Sub HScroll1_Change()
    UpdateHScroll
End Sub

Private Sub HScroll1_Scroll()
    UpdateHScroll
End Sub

Private Function MyFormat(Val#) As String
    Dim Log10#
    Log10# = Log(Abs(Val#)) / Log(10#)
    If (Log10# > 5#) Or (Log10# < -3#) Then
        MyFormat = Format(Val#, "0.00E-00")
    Else
        MyFormat = Format(Val#, "0.0###")
    End If
End Function

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (Button And 1) = 0 Then Exit Sub 'Only care about left button
    Dragging = False
    LeftButtonDown = True

    Dim NeedRepaint As Boolean
    Dim PickResult As Object
    Dim PickCount%
    Dim PenColor As Object 'Property object
    Dim Graphics As Object
    Dim CurX#, CurY#
    On Error GoTo Errors
    If Not (TheDrawing Is Nothing Or TheView Is Nothing) Then
        CurX# = X
        CurY# = Y
        TheView.ScreenToView CurX#, CurY#, StartX#, StartY#
        Select Case ActiveTool$
            Case "Star"
                Set Graphics = TheDrawing.Graphics
                Graphics.AddStar StartX#, StartY#, 0#
            Case "Select"
                Set PickResult = TheView.PickPoint(StartX#, StartY#, 0.1)
                PickCount% = PickResult.Count
                NeedRepaint = UnselectAll
                If PickCount% > 0 Then
                    Set SelectedGraphic = PickResult(0).Graphic
                    Set PenColor = SelectedGraphic.Properties("PenColor")
                    SavedColor = PenColor.Value
                    PenColor.Value = &HFF00FF 'Magenta
                    NeedRepaint = True
                End If
                If NeedRepaint Then Repaint
        End Select
    End If
Errors:
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (Button And 1) = 0 Then Exit Sub 'Only care about left button
    If Not LeftButtonDown Then Exit Sub 'Only if left button was down
    Dragging = True
End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (Button And 1) = 0 Then Exit Sub 'Only care about left button
    If Not LeftButtonDown Then Exit Sub

    Dim Graphics As Object
    Dim CurX#, CurY#
    Dim VX#, VY# 'Mouse coordinates in view space
    On Error GoTo Errors
    If Not (TheDrawing Is Nothing Or TheView Is Nothing) Then
        Set Graphics = TheDrawing.Graphics
        If ActiveTool$ <> "" Then
            CurX# = X
            CurY# = Y
            TheView.ScreenToView CurX#, CurY#, VX#, VY#
            Select Case ActiveTool$
                Case "Circle"
                    Graphics.AddCircleCenterAndPoint StartX#, StartY#, 0#, VX#, VY#, 0#
                    TheView.Update = True
                Case "Line"
                    Graphics.AddLineSingle StartX#, StartY#, 0#, VX#, VY#, 0#
                    TheView.Update = True
                Case "Curve"
                    If SplineGraphic Is Nothing Then
                        Set SplineGraphic = Graphics.AddCurveSpline(StartX#, StartY#, 0#)
                        Set SplineVerts = SplineGraphic.Vertices
                    End If
                    If Not (SplineVerts Is Nothing) Then SplineVerts.Add VX#, VY#, 0#
                    Repaint
                Case Else
            End Select
        End If
    End If
    Set Graphics = Nothing
    LeftButtonDown = False
    Dragging = False
    Exit Sub
Errors:
    Set SplineVerts = Nothing
    Set SplineGraphic = Nothing
    Set Graphics = Nothing
    LeftButtonDown = False
    Dragging = False
End Sub

Private Sub Picture1_Paint()
    If Not (TheView Is Nothing) Then
        TheView.Update = False
        TheView.hWnd = Picture1.hWnd
        TheView.MappingMode = 1
        TheView.Margins = False
        TheView.FixedAspectRatio = True
        If (ViewW# = 0#) And (ViewH# = 0#) Then
            'Initial settings
            TheView.ScreenLeft = Picture1.ScaleLeft
            TheView.ScreenTop = Picture1.ScaleTop
            TheView.ScreenWidth = Picture1.ScaleWidth
            TheView.ScreenHeight = Picture1.ScaleHeight
            TheView.ZoomToExtents
        Else
            'Saved settings
            TheView.Refresh
        End If

        'Update globals
        ViewL# = TheView.ViewLeft
        ViewT# = TheView.ViewTop
        ViewW# = TheView.ViewWidth
        ViewH# = TheView.ViewHeight

        'Feedback in status bar
        StatusBar1.Panels(2).Text = MyFormat(ViewL#)
        StatusBar1.Panels(3).Text = MyFormat(ViewT#)
        StatusBar1.Panels(4).Text = MyFormat(ViewW#)
        StatusBar1.Panels(5).Text = MyFormat(ViewH#)
    Else
        'Feedback in status bar
        StatusBar1.Panels(2).Text = "Left"
        StatusBar1.Panels(3).Text = "Top"
        StatusBar1.Panels(4).Text = "Width"
        StatusBar1.Panels(5).Text = "Height"
    End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As Button)
    KillModes
    ActiveTool$ = Button.Key
End Sub

Private Sub VScroll1_Change()
    UpdateVScroll
End Sub

Private Sub VScroll1_Scroll()
    UpdateVScroll
End Sub


Examples - TCADX - Camera1.bas

Camera1.bas

TCADX Example

Attribute VB_Name = "CameraMethods"
Public Sub Camera_Plan(ByVal TheView As View)
    If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
    End If
    Dim Cam1 As Object 'Camera   'IMSIGX.XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = 0
    Vpos.Y = 0
    Vpos.Z = 1

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 1
    VerUp.Z = 0
    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.Refresh
    TheView.ZoomToExtents
    TheView.Update = False
Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub
Public Sub Camera_Right(TheView As View)
    If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
    End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = 1
    Vpos.Y = 0
    Vpos.Z = 0

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub

Public Sub Camera_Left(TheView As View)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = -1
    Vpos.Y = 0
    Vpos.Z = 0

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub

Public Sub Camera_Front(TheView As View)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = 0
    Vpos.Y = -1
    Vpos.Z = 0

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub

Public Sub Camera_Back(TheView As View)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = 0
    Vpos.Y = 1
    Vpos.Z = 0

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub

Public Sub Camera_Bottom(TheView)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = 0
    Vpos.Y = 0
    Vpos.Z = 1 '-1

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = -1 '1
    VerUp.Z = 0

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub
Public Sub Camera_ISO_SE(TheView As View)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera

    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = 1
    Vpos.Y = -1
    Vpos.Z = 1

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub

Public Sub Camera_ISO_NE(TheView As View)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = 1
    Vpos.Y = 1
    Vpos.Z = 1

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing
Set Vi = Nothing
Set ActDr = Nothing

End Sub

Public Sub Camera_ISO_SW(TheView As View)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = -1
    Vpos.Y = -1
    Vpos.Z = 1

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub

Public Sub Camera_ISO_NW(TheView As View)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera

    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = -1
    Vpos.Y = 1
    Vpos.Z = 1

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing
End Sub


Examples - TCADX - clsTCADX.cls

clsTCADX.cls

TCADX Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsTCADX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private gxApp As XApplication
Private gxDwg As XDrawing
Private gxView As View

Private bInit As Boolean
Private idEvents As Long
Private events As New dlgTCADEvents
Private dwgs As New dlgDrawings

Public Function CreateTCApp() As Boolean

    On Error GoTo RunTCAD
    Set gxApp = GetObject(, "TurboCAD.Application")
    bInit = True
    gxApp.Visible = True
    CreateTCApp = True
    Exit Function
RunTCAD:
    On Error GoTo Error
    Set gxApp = CreateObject("TurboCAD.Application")
    gxApp.Visible = True
    bInit = True
    CreateTCApp = True
    Exit Function
Error:
    CreateTCApp = False
End Function

Private Sub Class_Initialize()
    bInit = False
    idEvents = -1
End Sub

Private Sub Class_Terminate()

    DisconnectEvents
    Unload events
    DetachDrawing
    Set gxApp = Nothing
End Sub

Public Function CreateGXApp()

     On Error GoTo Error
     Set gxApp = CreateObject("IMSIGX.Application")
     bInit = True
     CreateGXApp = True
     Exit Function
Error:
    CreateGXApp = False
End Function

Public Sub ConnectEvents()

    DisconnectEvents

    Dim mask As Long

    events.Show vbModal, frmTCADX

    If (events.bOK) Then
        If (events.mask <> 0) Then
            idEvents = gxApp.ConnectEvents(events, events.mask)
        End If
    End If
End Sub

Public Sub DisconnectEvents()

    If (idEvents <> -1) Then
        gxApp.DisconnectEvents idEvents
        idEvents = -1
    End If

End Sub

Public Function AttachToDrawing(hwnd As Long) As Boolean

    Dim gxDwgs As Drawings
    Dim nCnt As Long
    Dim indItem As Long

    Set gxDwgs = gxApp.Drawings
    nCnt = gxDwgs.Count() - 1

    dwgs.lstDwgs.Clear
    AttachToDrawing = False
    For indItem = 0 To nCnt

        dwgs.lstDwgs.AddItem gxDwgs(indItem).Name

    Next indItem

    dwgs.Show vbModal

    If (dwgs.bOK) Then
        DetachDrawing
        Set gxDwg = gxDwgs(dwgs.indDwg)
        Set gxView = gxDwg.Views.Add(hwnd)
    End If

    On Error GoTo Err:
'    frmTCADX.pbxView.Refresh
    gxView.ZoomToExtents
    AttachToDrawing = True
    Exit Function
Err:
End Function

Public Sub DetachDrawing()

    On Error Resume Next
    gxView.Delete
    Set gxView = Nothing
    Set gxDwg = Nothing

End Sub

Public Sub Refresh()
    On Error Resume Next
    gxView.Refresh
End Sub

Public Sub Scroll(dx As Long, dy As Long)

    Dim dxView As Long
    Dim dyView As Long

    Dim yTop As Double
    Dim xLeft As Double

    On Error GoTo Err

    xLeft = gxView.ViewLeft + gxView.ViewWidth() * dx / 10
    yTop = gxView.ViewTop - gxView.ViewHeight() * dy / 10

    gxView.Update = False

    gxView.ViewLeft = xLeft
    gxView.ViewTop = yTop

Err:
End Sub

Public Sub Zoom(factor As Double)

    If (factor <> 0) Then
        Dim xC As Double
        Dim yC As Double

        Dim w As Double
        Dim h As Double

        w = gxView.ViewWidth
        h = gxView.ViewHeight

        xC = gxView.ViewLeft + w / 2
        yC = gxView.ViewTop - h / 2

        w = w * factor
        h = h * factor

        gxView.Update = False

        gxView.ViewLeft = xC - w / 2
        gxView.ViewTop = yC + h / 2

        gxView.ViewWidth = w
        gxView.ViewHeight = h
    Else
        gxView.ZoomToExtents
    End If

End Sub

Public Function SelectByClick(X As Single, Y As Single, bSelect As Boolean) As Boolean
    Dim XScreen As Double
    Dim YScreen As Double

    Dim XView As Double
    Dim YView As Double

    Dim gxPickResult As PickResult
    Dim nCnt As Long
    Dim indItem As Long

    XScreen = X
    YScreen = Y

    SelectByClick = False
    On Error GoTo Err

    If (X >= 0 And Y >= 0) Then
        gxView.ScreenToView XScreen, YScreen, XView, YView

        Set gxPickResult = gxView.PickPoint(XView, YView)

        nCnt = gxPickResult.Count - 1

        For indItem = 0 To nCnt

            If (bSelect) Then
                gxPickResult(indItem).Graphic.Select
            Else
                gxPickResult(indItem).Graphic.Unselect
            End If

        Next indItem
    End If

    SelectByClick = (gxDwg.Selection.Count() > 0)
    Exit Function
Err:
End Function

Public Sub ScaleSelection(fScale As Double, bUseSelBBox As Boolean)

    Dim gxSel As Selection
    Dim gxGr As Graphic
    Dim gxMx As Matrix
    Dim gxSelBBox As BoundingBox
    Dim gxVrtMin As Vertex
    Dim gxVrtMax As Vertex

    Set gxSel = gxDwg.Selection

    Dim XRef As Double, YRef As Double, ZRef As Double

    If (bUseSelBBox) Then
        GetRefPoint gxSel, XRef, YRef, ZRef
    End If

    For Each gxGr In gxSel

        If (bUseSelBBox) Then
            Set gxMx = gxGr.Scale(fScale, fScale, fScale, XRef, YRef, ZRef)
        Else
            Set gxMx = gxGr.Scale(fScale, fScale, fScale)
        End If

    Next

    gxSel(0).Select
End Sub

Public Sub MoveSelectionToClick(X As Single, Y As Single, bUseSelBBox As Boolean)

    Dim XScreen As Double
    Dim YScreen As Double

    Dim XView As Double
    Dim YView As Double

    Dim XWorld As Double
    Dim YWorld As Double
    Dim ZWorld As Double

    Dim XUcs As Double
    Dim YUcs As Double
    Dim ZUcs As Double

    Dim XRef As Double
    Dim YRef As Double
    Dim ZRef As Double

    Dim XRefUcs As Double
    Dim YRefUcs As Double
    Dim ZRefUcs As Double

    Dim gxGr As Graphic
    Dim gxSel As Selection
    Dim gxMx As Matrix

    On Error GoTo Err

    XScreen = X
    YScreen = Y

    gxView.ScreenToView XScreen, YScreen, XView, YView
    gxView.ViewToWorld XView, YView, 0, XWorld, YWorld, ZWorld

    Set gxSel = gxDwg.Selection

    If (bUseSelBBox) Then

        GetRefPoint gxSel, XRef, YRef, ZRef

        For Each gxGr In gxSel

            Set gxMx = gxGr.MoveAbsolute(XWorld, YWorld, ZWorld, XRef, YRef, ZRef)

        Next

    Else

        For Each gxGr In gxSel

            Set gxMx = gxGr.MoveAbsolute(XUcs, YUcs, ZUcs)

        Next

    End If

    gxSel(0).Select
Err:
End Sub

Private Sub GetRefPoint(gxObj As Object, XRef As Double, YRef As Double, ZRef As Double)

    Dim gxBBox As BoundingBox
    Dim gxVrtMax As Vertex
    Dim gxVrtMin As Vertex

    Set gxBBox = gxObj.CalcBoundingBox

    Set gxVrtMin = gxBBox.Min
    Set gxVrtMax = gxBBox.Max

    XRef = gxVrtMin.X + (gxVrtMax.X - gxVrtMin.X) / 2
    YRef = gxVrtMin.Y + (gxVrtMax.Y - gxVrtMin.Y) / 2
    ZRef = gxVrtMin.Z + (gxVrtMax.Z - gxVrtMin.Z) / 2

End Sub

Public Sub RotateSelection(angle As Double, bUseSelBBox)

    Dim XRef As Double
    Dim YRef As Double
    Dim ZRef As Double

    Dim gxGr As Graphic
    Dim gxSel As Selection
    Dim gxMx As Matrix

    On Error GoTo Err

    angle = angle * PI / 180

    Set gxSel = gxDwg.Selection

    If (bUseSelBBox) Then

        GetRefPoint gxSel, XRef, YRef, ZRef

        For Each gxGr In gxSel

            Set gxMx = gxGr.RotateAxis(angle, , , , XRef, YRef, ZRef)

        Next

    Else

        For Each gxGr In gxSel

            Set gxMx = gxGr.RotateAxis(angle)

        Next

    End If

    gxSel(0).Select
Err:
End Sub

Public Sub ExplodeSelection()

    Dim gxSel As Selection
    Dim gxGr As Graphic

    On Error GoTo Err

    Set gxSel = gxDwg.Selection

    For Each gxGr In gxSel
        gxGr.Explode
    Next

    If gxSel.Count() > 0 Then
        gxSel(0).Select
    End If

Err:

End Sub

Public Sub CreateGroupFromSelection()

    Dim gxGroup As Graphic
    Dim gxGr As Graphic
    Dim gxGrs As Graphics
    Dim gxGrsGroup As Graphics
    Dim gxSel As Selection

    On Error GoTo Err
    Set gxGrs = gxDwg.Graphics
    Set gxGroup = gxGrs.Add(imsiGroup)
    Set gxGrsGroup = gxGroup.Graphics

    Set gxSel = gxDwg.Selection

    For Each gxGr In gxSel

        gxGrs.Remove gxGr.Index

        gxGrsGroup.AddGraphic gxGr
    Next

    Set gxGrsGroup = Nothing
    Set gxGrs = Nothing

    gxGroup.Select

    Exit Sub
Err:
    On Error Resume Next
    Set gxGrsGroup = Nothing
    Set gxGrs = Nothing
    gxGroup.Delete

End Sub
Public Sub OpenDrawing()
    Dim drname As String
    On Error Resume Next
    Err.Clear
    drname = gxApp.GetOpenFilename
    If Err.Number = 0 Then
        gxApp.Drawings.Open drname
        Err.Clear
        Exit Sub
    End If
    MsgBox Err.Description
    Err.Clear
End Sub
Public Sub SaveDrawing()
    Dim drname As String
    On Error Resume Next
    Err.Clear
    drname = gxApp.GetSaveAsFilename
    If Err.Number = 0 Then
        gxDwg.SaveAs drname
        Err.Clear
        Exit Sub
    End If
    MsgBox Err.Description
    Err.Clear
End Sub

Public Sub InsertDrawing()
    Dim pDwgEx As DwgEx
    Set pDwgEx = New DwgEx
    Dim drname As String
    Dim Gr As Graphic
    On Error Resume Next
    Err.Clear
    drname = gxApp.GetOpenFilename
    If Err.Number <> 0 Then
        MsgBox Err.Description
        Err.Clear
        Exit Sub
    End If
    Err.Clear
    pDwgEx.OpenFile drname
    Set Gr = pDwgEx.RunMerge(gxDwg, False)
' Now you can place the result graphic(group) in place you want
    gxView.Refresh
    Gr.Update
    Gr.Draw gxView
Set Gr = Nothing

End Sub
Public Sub closeDrawing()
    gxDwg.Close False
    Set gxView = Nothing
    Set gxDwg = Nothing
    frmTCADX.pbxView.Refresh
    frmTCADX.DisableButtons4
    frmTCADX.DisableButtons2
End Sub

Public Sub SpaceModeButtonControl()
    If gxDwg.Properties("TileMode") = 1 Then
        frmTCADX.btnSpaceMode.Caption = "M" ' model space
    Else
        frmTCADX.btnSpaceMode.Caption = "P"  ' paperspace
    End If
End Sub
Public Sub ChangeSpaceMode()
    If gxDwg.Properties("TileMode") = imsiModelSpace Then
        gxDwg.Properties("TileMode") = imsiPaperSpace
        gxView.SpaceMode = imsiPaperSpace
    Else
        gxDwg.Properties("TileMode") = imsiModelSpace
        gxView.SpaceMode = imsiModelSpace
    End If
    gxView.ZoomToExtents
    frmTCADX.pbxView.Refresh
    Call SpaceModeButtonControl
End Sub


Examples - TCADX - dlgCoords.frm

dlgCoords.frm

TCADX Example

VERSION 5.00
Begin VB.Form dlgCoords
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Click Coordinates"
   ClientHeight    =   1680
   ClientLeft      =   2760
   ClientTop       =   3756
   ClientWidth     =   6036
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1680
   ScaleWidth      =   6036
   ShowInTaskbar   =   0   'False
   Begin VB.TextBox txtZ3
      Height          =   288
      Left            =   4560
      TabIndex        =   8
      Top             =   1080
      Width           =   1212
   End
   Begin VB.TextBox txtY3
      Height          =   288
      Left            =   3240
      TabIndex        =   7
      Top             =   1080
      Width           =   1212
   End
   Begin VB.TextBox txtX3
      Height          =   288
      Left            =   1920
      TabIndex        =   6
      Top             =   1080
      Width           =   1212
   End
   Begin VB.TextBox txtY2
      Height          =   288
      Left            =   3240
      TabIndex        =   4
      Top             =   600
      Width           =   1212
   End
   Begin VB.TextBox txtX2
      Height          =   288
      Left            =   1920
      TabIndex        =   3
      Top             =   600
      Width           =   1212
   End
   Begin VB.TextBox txtY1
      Height          =   288
      Left            =   3240
      TabIndex        =   1
      Top             =   120
      Width           =   1212
   End
   Begin VB.TextBox txtX1
      Height          =   288
      Left            =   1920
      Locked          =   -1  'True
      TabIndex        =   0
      Top             =   120
      Width           =   1212
   End
   Begin VB.Label Label3
      Caption         =   "World coordinates :"
      Height          =   252
      Left            =   120
      TabIndex        =   9
      Top             =   1080
      Width           =   1692
   End
   Begin VB.Label Label2
      Caption         =   "View coordinates :"
      Height          =   252
      Left            =   120
      TabIndex        =   5
      Top             =   600
      Width           =   1692
   End
   Begin VB.Label Label1
      Caption         =   "Screen coordinates :"
      Height          =   252
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   1692
   End
End
Attribute VB_Name = "dlgCoords"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit


Examples - TCADX - dlgDrawings.frm

dlgDrawings.frm

TCADX Example

VERSION 5.00
Begin VB.Form dlgDrawings
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Select Drawing"
   ClientHeight    =   2268
   ClientLeft      =   2760
   ClientTop       =   3756
   ClientWidth     =   6036
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2268
   ScaleWidth      =   6036
   ShowInTaskbar   =   0   'False
   Begin VB.ListBox lstDwgs
      Height          =   1776
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   3972
   End
   Begin VB.CommandButton CancelButton
      Caption         =   "Cancel"
      Height          =   375
      Left            =   4680
      TabIndex        =   1
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton OKButton
      Caption         =   "OK"
      Height          =   375
      Left            =   4680
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
End
Attribute VB_Name = "dlgDrawings"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Public bOK As Boolean
Public indDwg As Long

Private Sub CancelButton_Click()
    Hide
End Sub

Private Sub Form_Activate()
    bOK = False
End Sub

Private Sub OKButton_Click()

    If (lstDwgs.SelCount() = 1) Then
        indDwg = lstDwgs.ListIndex
        bOK = True
    End If

    Hide
End Sub


Examples - TCADX - dlgSelectDrawing.frm

dlgSelectDrawing.frm

TCADX Example

VERSION 5.00
Begin VB.Form dlgDrawings
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Select Drawing"
   ClientHeight    =   2268
   ClientLeft      =   2760
   ClientTop       =   3756
   ClientWidth     =   6036
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2268
   ScaleWidth      =   6036
   ShowInTaskbar   =   0   'False
   Begin VB.ListBox lstDwgs
      Height          =   1776
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   3972
   End
   Begin VB.CommandButton CancelButton
      Caption         =   "Cancel"
      Height          =   375
      Left            =   4680
      TabIndex        =   1
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton OKButton
      Caption         =   "OK"
      Height          =   375
      Left            =   4680
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
End
Attribute VB_Name = "dlgDrawings"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit


Examples - TCADX - flgTCADEvents.frm

flgTCADEvents.frm

TCADX Example

VERSION 5.00
Begin VB.Form dlgTCADEvents
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "Select TCAD Events"
   ClientHeight    =   3192
   ClientLeft      =   2760
   ClientTop       =   3756
   ClientWidth     =   6036
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3192
   ScaleWidth      =   6036
   Begin VB.ListBox lstEvents
      Height          =   2928
      Left            =   120
      MultiSelect     =   1  'Simple
      TabIndex        =   2
      Top             =   120
      Width           =   3972
   End
   Begin VB.CommandButton CancelButton
      Caption         =   "Cancel"
      Height          =   375
      Left            =   4680
      TabIndex        =   1
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton OKButton
      Caption         =   "OK"
      Height          =   375
      Left            =   4680
      TabIndex        =   0
      Top             =   120
      Width           =   1215
   End
End
Attribute VB_Name = "dlgTCADEvents"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Public mask As Long
Public bOK As Boolean

Public coords As New dlgCoords

Private Sub CancelButton_Click()
    Hide
End Sub

Private Sub Form_Activate()
    bOK = False
End Sub

Private Sub Form_Load()

Dim indItem As Long
indItem = 0

lstEvents.AddItem "BeforeExit", indItem
lstEvents.ItemData(indItem) = imsiEventBeforeExit

indItem = indItem + 1
lstEvents.AddItem "DrawingNew", indItem
lstEvents.ItemData(indItem) = imsiEventDrawingNew

indItem = indItem + 1
lstEvents.AddItem "DrawingOpen", indItem
lstEvents.ItemData(indItem) = imsiEventDrawingOpen

indItem = indItem + 1
lstEvents.AddItem "DrawingActivate", indItem
lstEvents.ItemData(indItem) = imsiEventDrawingActivate

indItem = indItem + 1
lstEvents.AddItem "DrawingDeactivate", indItem
lstEvents.ItemData(indItem) = imsiEventDrawingDeactivate

indItem = indItem + 1
lstEvents.AddItem "DrawingBeforeClose", indItem
lstEvents.ItemData(indItem) = imsiEventDrawingBeforeClose

indItem = indItem + 1
lstEvents.AddItem "DrawingBeforeSave", indItem
lstEvents.ItemData(indItem) = imsiEventDrawingBeforeSave

indItem = indItem + 1
lstEvents.AddItem "MouseDown", indItem
lstEvents.ItemData(indItem) = imsiEventMouseDown

indItem = indItem + 1
lstEvents.AddItem "MouseUp", indItem
lstEvents.ItemData(indItem) = imsiEventMouseUp

indItem = indItem + 1
lstEvents.AddItem "MouseMove", indItem
lstEvents.ItemData(indItem) = imsiEventMouseMove

indItem = indItem + 1
lstEvents.AddItem "BeforeDoubleClick", indItem
lstEvents.ItemData(indItem) = imsiEventBeforeDoubleClick

indItem = indItem + 1
lstEvents.AddItem "BeforeRightClick", indItem
lstEvents.ItemData(indItem) = imsiEventBeforeRightClick

indItem = indItem + 1
lstEvents.AddItem "SelectionChange", indItem
lstEvents.ItemData(indItem) = imsiEventSelectionChange

indItem = indItem + 1
lstEvents.AddItem "RunTool", indItem
lstEvents.ItemData(indItem) = imsiEventRunTool

indItem = indItem + 1
lstEvents.AddItem "Drop", indItem
lstEvents.ItemData(indItem) = imsiEventDrop

indItem = indItem + 1
lstEvents.AddItem "DrawingAfterSave", indItem
lstEvents.ItemData(indItem) = imsiEventDrawingAfterSave

bOK = False

End Sub

Private Sub Form_Unload(Cancel As Integer)
    Unload coords
End Sub

Private Sub OKButton_Click()

    Dim nCnt As Long
    Dim indItem As Long
    nCnt = lstEvents.ListCount() - 1

    mask = 0

    For indItem = 0 To nCnt

        If (lstEvents.Selected(indItem)) Then
            mask = mask + lstEvents.ItemData(indItem)
        End If

    Next indItem

    bOK = True
    Hide
End Sub

Public Sub BeforeDoubleClick(ByVal WhichDrawing As IMSIGX.IDrawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Sel As IMSIGX.Selection, Cancel As IMSIGX.IMSI_BOOL)

    Cancel = False

End Sub

Public Sub BeforeExit(ByVal TheApp As IMSIGX.IApplication, Cancel As IMSIGX.IMSI_BOOL)

    Cancel = False

End Sub

Public Sub BeforeRightClick(ByVal WhichDrawing As IMSIGX.IDrawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Sel As IMSIGX.Selection, Cancel As IMSIGX.IMSI_BOOL)

    Cancel = False

End Sub

Public Sub DrawingActivate(ByVal WhichDrawing As IMSIGX.IDrawing)

End Sub

Public Sub DrawingAfterSave(ByVal WhichDrawing As IMSIGX.IDrawing)

End Sub

Public Sub DrawingBeforeClose(ByVal WhichDrawing As IMSIGX.IDrawing, Cancel As IMSIGX.IMSI_BOOL)

    Cancel = False

End Sub

Public Sub DrawingBeforeSave(ByVal WhichDrawing As IMSIGX.IDrawing, SaveAs As IMSIGX.IMSI_BOOL, Cancel As IMSIGX.IMSI_BOOL)

    Cancel = False

End Sub

Public Sub DrawingDeactivate(ByVal WhichDrawing As IMSIGX.IDrawing)

End Sub

Public Sub DrawingNew(ByVal WhichDrawing As IMSIGX.IDrawing)

End Sub

Public Sub DrawingOpen(ByVal WhichDrawing As IMSIGX.IDrawing)

End Sub

Public Sub Drop(ByVal WhichDrawing As IMSIGX.IDrawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Sel As IMSIGX.Selection)

End Sub

Public Sub MouseDown(ByVal WhichDrawing As IMSIGX.IDrawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Button As IMSIGX.ImsiMouseButton, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long, Cancel As IMSIGX.IMSI_BOOL)

    Dim XScreen As Double
    Dim YScreen As Double
    Dim XView As Double
    Dim YView As Double
    Dim XWorld As Double
    Dim YWorld As Double
    Dim ZWorld As Double

    XScreen = X
    YScreen = Y

    coords.txtX1.Text = CStr(X)
    coords.txtY1.Text = CStr(Y)

    WhichView.ScreenToView XScreen, YScreen, XView, YView
    WhichView.ViewToWorld XView, YView, 0#, XWorld, YWorld, ZWorld

    coords.txtX2.Text = CStr(XView)
    coords.txtY2.Text = CStr(YView)

    coords.txtX3 = CStr(XWorld)
    coords.txtY3 = CStr(YWorld)
    coords.txtZ3 = CStr(YWorld)

    coords.Show vbModeless
    Cancel = False

End Sub

Public Sub MouseMove(ByVal WhichDrawing As IMSIGX.IDrawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long, Cancel As IMSIGX.IMSI_BOOL)

    Dim XScreen As Double
    Dim YScreen As Double
    Dim XView As Double
    Dim YView As Double
    Dim XWorld As Double
    Dim YWorld As Double
    Dim ZWorld As Double

    XScreen = X
    YScreen = Y

    coords.txtX1 = CStr(X)
    coords.txtY1 = CStr(Y)

    WhichView.ScreenToView XScreen, YScreen, XView, YView
    WhichView.ViewToWorld XView, YView, 0#, XWorld, YWorld, ZWorld

    coords.txtX2 = CStr(XView)
    coords.txtY2 = CStr(YView)

    coords.txtX3 = CStr(XWorld)
    coords.txtY3 = CStr(YWorld)
    coords.txtZ3 = CStr(YWorld)

    coords.Show vbModeless
    Cancel = False

End Sub

Public Sub MouseUp(ByVal WhichDrawing As IMSIGX.IDrawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Button As IMSIGX.ImsiMouseButton, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long, Cancel As IMSIGX.IMSI_BOOL)

    Dim XScreen As Double
    Dim YScreen As Double
    Dim XView As Double
    Dim YView As Double
    Dim XWorld As Double
    Dim YWorld As Double
    Dim ZWorld As Double

    XScreen = X
    YScreen = Y

    coords.txtX1 = CStr(X)
    coords.txtY1 = CStr(Y)

    WhichView.ScreenToView XScreen, YScreen, XView, YView
    WhichView.ViewToWorld XView, YView, 0#, XWorld, YWorld, ZWorld

    coords.txtX2 = CStr(XView)
    coords.txtY2 = CStr(YView)

    coords.txtX3 = CStr(XWorld)
    coords.txtY3 = CStr(YWorld)
    coords.txtZ3 = CStr(YWorld)

    coords.Show vbModeless
    Cancel = False

End Sub

Public Sub RunTool(ByVal WhichTool As IMSIGX.Tool)

End Sub

Public Sub SelectionChange(ByVal WhichDrawing As IMSIGX.IDrawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Sel As IMSIGX.Selection)

End Sub


Examples - TCADX - frmTCADX.frm

frmTCADX.frm

TCADX Example

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "Comdlg32.ocx"
Begin VB.Form frmTCADX
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "TurboCAD SDK client application"
   ClientHeight    =   8835
   ClientLeft      =   30
   ClientTop       =   270
   ClientWidth     =   8400
   Icon            =   "frmTCADX.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   MousePointer    =   99  'Custom
   ScaleHeight     =   8835
   ScaleWidth      =   8400
   StartUpPosition =   3  'Windows Default
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   240
      Top             =   7320
      _ExtentX        =   688
      _ExtentY        =   688
      _Version        =   393216
   End
   Begin VB.CommandButton btnRotate
      Caption         =   "Rotate Selection"
      Enabled         =   0   'False
      Height          =   372
      Left            =   5034
      TabIndex        =   20
      ToolTipText     =   "Rotate selected objects"
      Top             =   1800
      Width           =   1452
   End
   Begin VB.CommandButton btnMove
      Caption         =   "Move Selection"
      Enabled         =   0   'False
      Height          =   372
      Left            =   3474
      TabIndex        =   19
      ToolTipText     =   "Move selected objects(s)"
      Top             =   1800
      Width           =   1452
   End
   Begin VB.CommandButton btnScale
      Caption         =   "Scale Selection"
      Enabled         =   0   'False
      Height          =   372
      Left            =   1914
      TabIndex        =   18
      ToolTipText     =   "Scale selected object(s)"
      Top             =   1800
      Width           =   1452
   End
   Begin VB.CommandButton btnGroup
      Caption         =   "Create Group"
      Enabled         =   0   'False
      Height          =   372
      Left            =   5034
      TabIndex        =   17
      ToolTipText     =   "Create group from selected objects"
      Top             =   1320
      Width           =   1452
   End
   Begin VB.CommandButton btnExplode
      Caption         =   "Explode"
      Enabled         =   0   'False
      Height          =   372
      Left            =   3474
      TabIndex        =   16
      ToolTipText     =   "Explode selected object(s)"
      Top             =   1320
      Width           =   1452
   End
   Begin VB.CommandButton btnSelect
      Caption         =   "Select/Unselect"
      Enabled         =   0   'False
      Height          =   372
      Left            =   1914
      TabIndex        =   15
      ToolTipText     =   "Select/Unselect object by click"
      Top             =   1320
      Width           =   1452
   End
   Begin VB.CommandButton btnAttach
      Caption         =   "Attach to Drawing"
      Enabled         =   0   'False
      Height          =   372
      Left            =   294
      TabIndex        =   14
      ToolTipText     =   "Attach to opened drawing"
      Top             =   735
      Width           =   1452
   End
   Begin VB.CommandButton btnInsert
      Caption         =   "Insert Drawing"
      Enabled         =   0   'False
      Height          =   372
      Left            =   3594
      TabIndex        =   13
      ToolTipText     =   "Insert drawing into current drawig"
      Top             =   720
      Width           =   1332
   End
   Begin VB.CommandButton btnSave
      Caption         =   "Save Drawing"
      Enabled         =   0   'False
      Height          =   372
      Left            =   5124
      TabIndex        =   12
      ToolTipText     =   "Save current drawing with another file name"
      Top             =   720
      Width           =   1452
   End
   Begin VB.CommandButton btnClose
      Caption         =   "Close Drawing"
      Enabled         =   0   'False
      Height          =   372
      Left            =   6774
      TabIndex        =   11
      ToolTipText     =   "Close current drawing"
      Top             =   720
      Width           =   1332
   End
   Begin VB.CommandButton btnOpen
      Caption         =   "Open Drawing"
      Enabled         =   0   'False
      Height          =   372
      Left            =   1944
      TabIndex        =   10
      ToolTipText     =   "Open existing drawing"
      Top             =   720
      Width           =   1452
   End
   Begin VB.CommandButton btnRefresh
      Caption         =   "Refresh"
      Enabled         =   0   'False
      Height          =   372
      Left            =   5454
      TabIndex        =   9
      Top             =   7320
      Width           =   1092
   End
   Begin VB.CommandButton btnZoomOut
      Caption         =   "Zoom Out"
      Enabled         =   0   'False
      Height          =   372
      Left            =   4254
      TabIndex        =   8
      Top             =   7320
      Width           =   1092
   End
   Begin VB.CommandButton btnZoomAll
      Caption         =   "Zoom All"
      Enabled         =   0   'False
      Height          =   372
      Left            =   3054
      TabIndex        =   7
      Top             =   7320
      Width           =   1092
   End
   Begin VB.CommandButton btnZoomIn
      Caption         =   "Zoom In"
      Enabled         =   0   'False
      Height          =   372
      Left            =   1854
      TabIndex        =   6
      Top             =   7320
      Width           =   1092
   End
   Begin VB.VScrollBar VScroll1
      Height          =   4692
      Left            =   7974
      Max             =   10
      TabIndex        =   5
      Top             =   2520
      Value           =   5
      Width           =   252
   End
   Begin VB.HScrollBar HScroll1
      Height          =   252
      Left            =   174
      Max             =   10
      TabIndex        =   4
      Top             =   2280
      Value           =   5
      Width           =   7812
   End
   Begin VB.CommandButton btnConnectEvents
      Caption         =   "Connect to TurboCAD Events"
      Enabled         =   0   'False
      Height          =   372
      Left            =   2934
      TabIndex        =   3
      Top             =   120
      Width           =   2412
   End
   Begin VB.CommandButton btnCreateGXApp
      Caption         =   "Create IMSIGX.Aplication"
      Height          =   372
      Left            =   5574
      TabIndex        =   2
      ToolTipText     =   "Inproc Server"
      Top             =   120
      Width           =   2532
   End
   Begin VB.CommandButton btnCreateTCApp
      Caption         =   "Create TurboCAD.Application"
      Height          =   372
      Left            =   294
      TabIndex        =   1
      ToolTipText     =   "Local Server"
      Top             =   120
      Width           =   2532
   End
   Begin VB.PictureBox pbxView
      Height          =   4692
      Left            =   174
      ScaleHeight     =   309
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   517
      TabIndex        =   0
      Top             =   2520
      Width           =   7812
      Begin VB.CommandButton btnSpaceMode
         Height          =   315
         Left            =   -15
         TabIndex        =   21
         ToolTipText     =   "current space mode (click to change it)"
         Top             =   -15
         Width           =   300
      End
   End
   Begin VB.Line Line3
      X1              =   300
      X2              =   8112
      Y1              =   1200
      Y2              =   1212
   End
   Begin VB.Line Line2
      X1              =   5454
      X2              =   5466
      Y1              =   120
      Y2              =   612
   End
   Begin VB.Line Line1
      X1              =   240
      X2              =   8112
      Y1              =   600
      Y2              =   612
   End
End
Attribute VB_Name = "frmTCADX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Enum TCADKIND
    tcadLocal
    tcadInproc
End Enum

Enum ACTION
    actNone
    actSelect
    actMove
    actScale
End Enum
Dim curAppMode As TCADKIND

Private state As ACTION
Private TCAD As New clsTCADX

Private Sub btnAttach_Click()

    DisableButtons2
    If (TCAD.AttachToDrawing(pbxView.hwnd)) Then
        EnableButtons2
        If (TCAD.SelectByClick(-1, -1, True)) Then
            EnableButtons4
        End If
        frmTCADX.btnSpaceMode.Enabled = True
        TCAD.SpaceModeButtonControl
        frmTCADX.Refresh
    End If

End Sub

Private Sub btnClose_Click()
    TCAD.closeDrawing
End Sub

Private Sub btnConnectEvents_Click()

   TCAD.ConnectEvents

End Sub

Private Sub btnCreateGXApp_Click()
    If (TCAD.CreateGXApp()) Then
        EnableButtons1 tcadInproc
        curAppMode = tcadInproc
    End If
End Sub

Private Sub btnCreateTCApp_Click()
    If (TCAD.CreateTCApp()) Then
        EnableButtons1 tcadLocal
        curAppMode = tcadLocal
    End If
End Sub

Public Sub EnableButtons1(kind As TCADKIND)
    Select Case kind
        Case tcadLocal
        btnCreateGXApp.Enabled = False
        btnConnectEvents.Enabled = True
        Case tcadInproc
        btnCreateGXApp.Enabled = True
    End Select

    btnAttach.Enabled = True
    btnOpen.Enabled = True

End Sub

Private Sub btnExplode_Click()
    TCAD.ExplodeSelection
End Sub

Private Sub btnGroup_Click()

    TCAD.CreateGroupFromSelection
    pbxView.Refresh

End Sub

Private Sub btnInsert_Click()
    TCAD.InsertDrawing
End Sub

Private Sub btnMove_Click()

    SetState actMove

End Sub

Private Sub btnOpen_Click()
    TCAD.OpenDrawing
End Sub

Private Sub btnRefresh_Click()
    pbxView.Refresh
End Sub

Private Sub btnRotate_Click()
    TCAD.RotateSelection 10, True
    pbxView.Refresh
End Sub

Private Sub btnSave_Click()
    TCAD.SaveDrawing
End Sub

Private Sub btnScale_Click()
    TCAD.ScaleSelection 1.5, True
    pbxView.Refresh
End Sub

Private Sub btnSelect_Click()
    SetState actSelect
End Sub

Private Sub btnSpaceMode_Click()
    TCAD.ChangeSpaceMode
End Sub

Private Sub btnZoomAll_Click()
    TCAD.Zoom 0
    pbxView.Refresh

End Sub

Private Sub btnZoomIn_Click()

    TCAD.Zoom 1 / 1.5
    pbxView.Refresh

End Sub

Private Sub btnZoomOut_Click()

    TCAD.Zoom 1.5
    pbxView.Refresh

End Sub

Private Sub Form_Load()
    SetState actNone
End Sub

Private Sub HScroll1_Change()

    Dim dx As Long

    dx = HScroll1.Value - 5

    If (dx <> 0) Then
        TCAD.Scroll dx, 0
        HScroll1.Value = 5
    End If

    pbxView.Refresh
End Sub

Private Sub pbxView_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Select Case Button
        Case imsiLeftButton
            OnLButtonDown X, Y
        Case imsiRightButton
            OnRButtonDown X, Y
    End Select

    pbxView.Refresh

End Sub

Private Sub pbxView_Paint()

    TCAD.Refresh

End Sub

Private Sub VScroll1_Change()

    Dim dy As Long
    dy = VScroll1.Value - 5

    If (dy <> 0) Then
        TCAD.Scroll 0, dy
        VScroll1.Value = 5
    End If

    pbxView.Refresh

End Sub

Public Sub EnableButtons2()

    If curAppMode = tcadInproc Then
    ' doesn't allow to insert file in local servermode
    ' it can be done from TurboCAD by Insert\File
        btnInsert.Enabled = True
    End If
    btnSave.Enabled = True
    btnClose.Enabled = True
    btnSelect.Enabled = True
    btnZoomIn.Enabled = True
    btnZoomAll.Enabled = True
    btnZoomOut.Enabled = True
    btnRefresh.Enabled = True

End Sub

Public Sub DisableButtons2()

    btnInsert.Enabled = False
    btnSave.Enabled = False
    btnClose.Enabled = False
    btnSelect.Enabled = False
    btnZoomIn.Enabled = False
    btnZoomAll.Enabled = False
    btnZoomOut.Enabled = False
    btnRefresh.Enabled = False

End Sub

Public Sub SetState(actstate As ACTION)

    state = actstate
    Select Case state
    Case actNone
        MouseIcon = LoadResPicture(101, vbResCursor)
    Case actSelect
        MouseIcon = LoadResPicture(102, vbResCursor)

    Case actMove
        MouseIcon = LoadResPicture(103, vbResCursor)
    End Select

End Sub

Public Sub OnLButtonDown(X As Single, Y As Single)

    Select Case state
        Case actSelect
            DisableButtons4
            If (TCAD.SelectByClick(X, Y, True)) Then
                EnableButtons4
            End If

        Case actMove
            TCAD.MoveSelectionToClick X, Y, True
    End Select

End Sub

Public Sub OnRButtonDown(X As Single, Y As Single)

    Select Case state
        Case actSelect
            DisableButtons4
            If (TCAD.SelectByClick(X, Y, False)) Then
                EnableButtons4
            End If
    End Select

End Sub

Public Sub EnableButtons4()

    btnExplode.Enabled = True
    btnGroup.Enabled = True
    btnScale.Enabled = True
    btnMove.Enabled = True
    btnRotate.Enabled = True
    btnSpaceMode.Enabled = True
End Sub

Public Sub DisableButtons4()

    btnExplode.Enabled = False
    btnGroup.Enabled = False
    btnScale.Enabled = False
    btnMove.Enabled = False
    btnRotate.Enabled = False
    btnSpaceMode.Enabled = False
End Sub


Examples - TCADX - mdlTCADX.bas

mdlTCADX.bas

TCADX Example

Attribute VB_Name = "mdlTCADX"
Option Explicit
Public Const PI = 3.14159265358979

Public Sub Main()

    frmTCADX.Show vbModeless

End Sub


Examples - TurboCAD Viewer - frmVbCamera.frm

frmVbCamera.frm

TurboCAD Viewer Example

VERSION 5.00
Begin VB.Form frmVbCamera
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "TurboCAD view"
   ClientHeight    =   5640
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8940
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5640
   ScaleWidth      =   8940
   ShowInTaskbar   =   0   'False
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton CmOrbit
      Caption         =   "Orbit"
      Enabled         =   0   'False
      Height          =   375
      Left            =   7440
      TabIndex        =   6
      Top             =   2895
      Width           =   1275
   End
   Begin VB.CommandButton cmZoomAll
      Caption         =   "Zoom Extents"
      Height          =   375
      Left            =   7440
      TabIndex        =   4
      Top             =   2190
      Width           =   1275
   End
   Begin VB.CommandButton cmZoomOut
      Caption         =   "ZoomOut"
      Height          =   375
      Left            =   7440
      TabIndex        =   3
      Top             =   1575
      Width           =   1275
   End
   Begin VB.CommandButton cmZoomIn
      Caption         =   "ZoomIn"
      Height          =   375
      Left            =   7440
      TabIndex        =   2
      Top             =   960
      Width           =   1275
   End
   Begin VB.CommandButton cmOpen
      Caption         =   "Open"
      Height          =   375
      Left            =   7440
      TabIndex        =   1
      Top             =   375
      Width           =   1275
   End
   Begin VB.PictureBox picPreview
      Height          =   4275
      Left            =   450
      ScaleHeight     =   4215
      ScaleWidth      =   5745
      TabIndex        =   0
      Top             =   345
      Width           =   5805
      Begin VB.CommandButton cmSpaceMode
         Height          =   255
         Left            =   0
         TabIndex        =   5
         TabStop         =   0   'False
         Top             =   3975
         Width           =   255
      End
   End
End
Attribute VB_Name = "frmVbCamera"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const M_PI = 3.14159265358979

Private Sub cmOpen_Click()
    Dim fName As String
    On Error Resume Next
    Err.Clear
    fName = ""
    fName = gxApp.GetOpenFilename("TCW", "Select a file", False)
    On Error GoTo ErrH
    Err.Clear
    If fName <> "" Then
        Set gxDr = gxApp.Drawings.Open(fName)
        Call AddPreview
On Error Resume Next
        Call Camera_Plan(gxView)
        gxView.ZoomToExtents
Err.Clear
        Call EnableButtons
        cmZoomAll.SetFocus
    End If
    Exit Sub
ErrH:
    MsgBox Err.Description
    Err.Clear
End Sub

Private Sub AddPreview()
    Set gxView = gxDr.Views.Add(picPreview.hWnd)
Dim varVal As Integer
    varVal = gxDr.Properties("TileMode")
'    If gxView.SpaceMode = imsiModelSpace Then
    If varVal = imsiModelSpace Then
        gxView.SpaceMode = imsiModelSpace
        cmSpaceMode.Caption = "M"
        CmOrbit.Enabled = True
    Else
        gxView.SpaceMode = imsiPaperSpace
        cmSpaceMode.Caption = "P"
        CmOrbit.Enabled = False
    End If
    gxView.ZoomToExtents
End Sub

Private Sub CmOrbit_Click()
    Dim Cam As XCamera
    Dim i As Long
    Dim angle As Double
' Note we only can manipulate camera object if currect view mode is model space
    Set Cam = gxView.Camera
    angle = 18
    ' recalculate angle in radian
    angle = angle * M_PI / 180
MsgBox "Camera is moving along the orbit is in XY pane"
    For i = 0 To 19
        Cam.Orbit angle, False, 0, 0, 1
        picPreview.Refresh
        gxView.Refresh
'        MsgBox i
    Next i
MsgBox "Camera is moving along the orbit in YZ pane"
    For i = 0 To 19
        Cam.Orbit angle, False, 1, 0, 0
        picPreview.Refresh
        gxView.Refresh
    Next i
MsgBox "Camera is moving along the orbit in XZ pane"
    For i = 0 To 19
        Cam.Orbit angle, False, 0, 1, 0
        picPreview.Refresh
        gxView.Refresh
'        MsgBox i
    Next i

Set Cam = Nothing
End Sub

Private Sub cmSpaceMode_Click()
    If gxView.SpaceMode = imsiModelSpace Then
        gxView.Drawing.Properties("TileMode") = imsiPaperSpace
        gxView.SpaceMode = imsiPaperSpace
        cmSpaceMode.Caption = "P"
        CmOrbit.Enabled = False
    Else
        gxView.Drawing.Properties("TileMode") = imsiModelSpace
        gxView.SpaceMode = imsiModelSpace
        cmSpaceMode.Caption = "M"
        CmOrbit.Enabled = True
    End If
    cmZoomAll.SetFocus
    picPreview.Refresh
    gxView.ZoomToExtents

End Sub

Private Sub cmZoomAll_Click()
    picPreview.Refresh
    gxView.ZoomToExtents
End Sub

Private Sub cmZoomIn_Click()
    Call Zoom(0.8)
    picPreview.Refresh
    gxView.Refresh
End Sub

Private Sub cmZoomOut_Click()
    Call Zoom(1.2)
    picPreview.Refresh
    gxView.Refresh
End Sub

Private Sub Form_Initialize()
    Call DisableButtons
End Sub

Private Sub Form_Terminate()
    On Error Resume Next
    gxView.Delete
    Set gxView = Nothing
    gxDr.Close False
    Set gxDr = Nothing
'    gxApp.Quit
    Set gxApp = Nothing
End Sub
Public Sub Zoom(factor As Double)
    If (factor <> 0) Then
        On Error GoTo VwZoom
        gxView.Camera.Zoom factor
        Exit Sub
    Else
        gxView.ZoomToExtents
    End If
    Exit Sub
VwZoom:
        Dim xC As Double
        Dim yC As Double

        Dim w As Double
        Dim h As Double

        On Error GoTo Err
        w = gxView.ViewWidth
        h = gxView.ViewHeight

        xC = gxView.ViewLeft + w / 2
        yC = gxView.ViewTop - h / 2

        w = w * factor
        h = h * factor

        gxView.Update = False

        gxView.ViewLeft = xC - w / 2
        gxView.ViewTop = yC + h / 2

        gxView.ViewWidth = w
        gxView.ViewHeight = h
Err:
End Sub

Private Sub EnableButtons()
    cmZoomIn.Enabled = True
    cmZoomOut.Enabled = True
    cmZoomAll.Enabled = True
End Sub
Private Sub DisableButtons()
    cmZoomIn.Enabled = False
    cmZoomOut.Enabled = False
    cmZoomAll.Enabled = False
End Sub


Examples - TurboCAD Viewer - modTCView.bas

modTCView.bas

TurboCAD Viewer Example

Attribute VB_Name = "modTCView"
Option Explicit
Global gxApp As XApplication
Global gxDr As Drawing
Global gxView As View

Sub Main()
    Set gxApp = New XApplication
    frmVbCamera.Show vbModal
    'qxApp.Quit

End Sub


Examples - TurboCAD Viewer - modVbCamera.bas

modVbCamera.bas

TurboCAD Viewer Example

Attribute VB_Name = "modVbCamera"
Option Explicit
Public Sub Camera_Plan(TheView As View)
    If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
    End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = 0
    Vpos.Y = 0
    Vpos.Z = 1

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 1
    VerUp.Z = 0
    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.Refresh
    TheView.ZoomToExtents
    TheView.Update = False
Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub
Public Sub Camera_Right(TheView As View)
    If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
    End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = 1
    Vpos.Y = 0
    Vpos.Z = 0

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub

Public Sub Camera_Left(TheView As View)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = -1
    Vpos.Y = 0
    Vpos.Z = 0

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub

Public Sub Camera_Front(TheView As View)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = 0
    Vpos.Y = -1
    Vpos.Z = 0

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub

Public Sub Camera_Back(TheView As View)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = 0
    Vpos.Y = 1
    Vpos.Z = 0

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub

Public Sub Camera_Bottom(TheView)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = 0
    Vpos.Y = 0
    Vpos.Z = 1 '-1

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = -1 '1
    VerUp.Z = 0

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub
Public Sub Camera_ISO_SE(TheView As View)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = 1
    Vpos.Y = -1
    Vpos.Z = 1

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub

Public Sub Camera_ISO_NE(TheView As View)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = 1
    Vpos.Y = 1
    Vpos.Z = 1

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub

Public Sub Camera_ISO_SW(TheView As View)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera
    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = -1
    Vpos.Y = -1
    Vpos.Z = 1

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing

End Sub

Public Sub Camera_ISO_NW(TheView As View)
  If (TheView.SpaceMode = imsiPaperSpace) Then
        MsgBox "Camera's properties can be changed only in model space"
        Exit Sub
        'Camera's properties can be changed only in model space
  End If
    Dim Cam1 As XCamera
    Dim Vpos As XVertex
    Dim VLookAt As Vertex
    Dim VerUp As Vertex

    Set Cam1 = TheView.Camera

    Set Vpos = New XVertex
    Set VLookAt = Vpos.Duplicate
    Set VerUp = Vpos.Duplicate

    Vpos.X = -1
    Vpos.Y = 1
    Vpos.Z = 1

    VLookAt.X = 0
    VLookAt.Y = 0
    VLookAt.Z = 0

    VerUp.X = 0
    VerUp.Y = 0
    VerUp.Z = 1

    Cam1.CameraSetSpaceParameters Vpos, VLookAt, VerUp
    TheView.ZoomToExtents
    TheView.Refresh

Set VerUp = Nothing
Set Vpos = Nothing
Set VLookAt = Nothing
Set Cam1 = Nothing
End Sub


Examples - TCADApi.bas

TCADApi.bas

Attribute VB_Name = "FunctionDeclarations"
' App functions

Declare Sub TCWAppExit Lib "TCAPI60.dll" ()
Declare Function TCWActiveWindow Lib "TCAPI60.dll" () As Long
Declare Function TCWBasicRun Lib "TCAPI60.dll" (ByVal script As String) As Long
Declare Function TCWLastErrorGet Lib "TCAPI60.dll" (ByVal pszErrorString As String) As Long
Declare Sub TCWClearError Lib "TCAPI60.dll" ()

' Drawing functions

Declare Function TCWDrawingNew Lib "TCAPI60.dll" () As Long
Declare Function TCWDrawingOpen Lib "TCAPI60.dll" (ByVal dName As String) As Long
Declare Function TCWDrawingClose Lib "TCAPI60.dll" (ByVal savechanges As Long) As Long
Declare Function TCWDrawingSave Lib "TCAPI60.dll" () As Long
Declare Function TCWDrawingSaveAs Lib "TCAPI60.dll" (ByRef dName As String, ByVal saveselection As Long) As Long
Declare Function TCWDrawingName Lib "TCAPI60.dll" (ByRef dName As String) As Long
Declare Function TCWDrawingAt Lib "TCAPI60.dll" (ByVal Index As Long) As Long
Declare Function TCWDrawingCount Lib "TCAPI60.dll" () As Long
Declare Function TCWDrawingPrint Lib "TCAPI60.dll" (ByVal showdialog As Long) As Long
Declare Function TCWDrawingActive Lib "TCAPI60.dll" () As Long

' Undo functions
Declare Function TCWUndoClear Lib "TCAPI60.dll" () As Long
Declare Function TCWUndo Lib "TCAPI60.dll" (ByVal n As Long) As Long
Declare Function TCWRedo Lib "TCAPI60.dll" () As Long
Declare Function TCWUndoRecordEnd Lib "TCAPI60.dll" (ByVal d As Long) As Long
Declare Function TCWUndoRecordStart Lib "TCAPI60.dll" (ByVal d As Long, ByRef title As String) As Long
Declare Function TCWUndoRecordAddGraphic Lib "TCAPI60.dll" (ByVal d As Long, ByVal g As Long) As Long

' Edit functions

Declare Function TCWSelectAll Lib "TCAPI60.dll" () As Long
Declare Function TCWDeselectAll Lib "TCAPI60.dll" () As Long
Declare Function TCWClearSelection Lib "TCAPI60.dll" () As Long
Declare Function TCWClearAll Lib "TCAPI60.dll" () As Long
Declare Function TCWClearAllConstructions Lib "TCAPI60.dll" () As Long
Declare Function TCWSelectByQuery Lib "TCAPI60.dll" (ByRef s As String) As Long
Declare Function TCWSelectionCount Lib "TCAPI60.dll" () As Long
Declare Function TCWSelectionAt Lib "TCAPI60.dll" (ByVal Index As Long) As Long

' Insert functions

' insert cunstruction lines
Declare Function TCWConstructionAngularLine Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double) As Long
Declare Function TCWConstructionHorizontalLine Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWConstructionVerticalLine Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWConstructionCenterAndPointCircle Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double) As Long
Declare Function TCWConstructionDoublePointCircle Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double) As Long
Declare Function TCWConstructionTriplePointCircle Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal z2 As Double) As Long
' insert point
Declare Function TCWDot Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWStar Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWSquare Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWCross Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long

' insert circle - ellipse
Declare Function TCWCircle Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWCircleCenterAndPoint Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double) As Long
Declare Function TCWCircleDoublePoint Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double) As Long
Declare Function TCWCircleTriplePoint Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal z2 As Double) As Long
Declare Function TCWEllipse Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double) As Long
Declare Function TCWEllipseRotatedEllipse Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal z2 As Double) As Long
Declare Function TCWEllipseFixedRatio Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal xyratio As Double) As Long

' insert a line
Declare Function TCWLineSingle Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double) As Long
Declare Function TCWLinePolygon Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal nsides As Long) As Long
Declare Function TCWLineRectangle Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double) As Long
Declare Function TCWLineRotatedRectangle Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal height As Double) As Long
Declare Function TCWLinePerpendicular Lib "TCAPI60.dll" (ByVal g As Long, ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWLineParallel Lib "TCAPI60.dll" (ByVal g As Long, ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWLineMultiline Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWLineIrregularPolygon Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long

' insert a double line
Declare Function TCWDoubleLineMultiline Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWDoubleLineIrregularPolygon Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWCurveBezier Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWCurveSpline Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWDoubleLineSingle Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double) As Long
Declare Function TCWDoubleLinePolygon Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal nsides As Long) As Long
Declare Function TCWDoubleLineRectangle Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double) As Long
Declare Function TCWDoubleLineRotatedRectangle Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal height As Double) As Long
Declare Function TCWDoubleLinePerpendicular Lib "TCAPI60.dll" (ByVal g As Long, ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double) As Long
Declare Function TCWDoubleLineParallel Lib "TCAPI60.dll" (ByVal g As Long, ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
'insert arc
Declare Function TCWArcCenterAndPoint Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal startangle As Double, ByVal endangle As Double) As Long
Declare Function TCWArcDoublePoint Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal startangle As Double, ByVal endangle As Double) As Long
Declare Function TCWArcTriplePoint Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal z2 As Double) As Long
Declare Function TCWArcElliptical Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal startangle As Double, ByVal endangle As Double) As Long
Declare Function TCWArcRotatedElliptical Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal z2 As Double, ByVal startangle As Double, ByVal endangle As Double) As Long
Declare Function TCWArcEllipticalFixedRatio Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal xyratio As Double, ByVal startangle As Double, ByVal endangle As Double) As Long
' insert text
Declare Function TCWText Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByRef textstr As String, ByVal size As Double, ByVal angle As Double) As Long
' insert dimension
Declare Function TCWDimensionHorizontal Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal z2 As Double) As Long
Declare Function TCWDimensionHorizontalEntity Lib "TCAPI60.dll" (ByVal g As Long, ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWDimensionVertical Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal z2 As Double) As Long
Declare Function TCWDimensionVerticalEntity Lib "TCAPI60.dll" (ByVal g As Long, ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWDimensionParallel Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal z2 As Double) As Long
Declare Function TCWDimensionParallelEntity Lib "TCAPI60.dll" (ByVal g As Long, ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long

' block's functions
Declare Function TCWBlockGet Lib "TCAPI60.dll" (ByRef blockname As String) As Long
Declare Function TCWBlockCreate Lib "TCAPI60.dll" (ByRef blockname As String) As Long
Declare Function TCWBlockInsert Lib "TCAPI60.dll" (ByRef blockname As String, ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
' graphic's functions
Declare Function TCWGraphicCount Lib "TCAPI60.dll" (ByVal d As Long) As Long
Declare Function TCWGraphicAt Lib "TCAPI60.dll" (ByVal d As Long, ByVal Index As Long) As Long
Declare Function TCWGraphicAppend Lib "TCAPI60.dll" (ByVal g1 As Long, ByVal g2 As Long) As Long
Declare Function TCWGraphicXYZAdd Lib "TCAPI60.dll" (ByVal g As Long, ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWGraphicClose Lib "TCAPI60.dll" (ByVal g As Long) As Long
Declare Function TCWGraphicVertexAdd Lib "TCAPI60.dll" (ByVal g As Long, ByVal v As Long) As Long
Declare Function TCWVertexAppend Lib "TCAPI60.dll" (ByVal g As Long, ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWGraphicCopy Lib "TCAPI60.dll" (ByVal g As Long) As Long
Declare Function TCWGraphicDispose Lib "TCAPI60.dll" (ByVal g As Long) As Long
Declare Function TCWGraphicCreate Lib "TCAPI60.dll" (ByVal kind As Long, ByRef regenmethod As String) As Long
Declare Function TCWGraphicDraw Lib "TCAPI60.dll" (ByVal g As Long, ByVal mode As Long) As Long
Declare Function TCWGraphicHandleFromID Lib "TCAPI60.dll" (ByVal id As Long) As Long
Declare Function TCWGraphicReferencePointSet Lib "TCAPI60.dll" (ByVal g As Long, ByVal v As Long) As Long
Declare Function TCWGraphicReferencePointGet Lib "TCAPI60.dll" (ByVal g As Long) As Long
Declare Function TCWVertexFindGraphic Lib "TCAPI60.dll" (ByVal v As Long) As Long

' selection functions
Declare Function TCWSelectionScale Lib "TCAPI60.dll" (ByVal xscale As Double, ByVal yscale As Double, ByVal zscale As Double, ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWSelectionMove Lib "TCAPI60.dll" (ByVal dx As Double, ByVal dy As Double, ByVal dz As Double) As Long
Declare Function TCWSelectionRotate Lib "TCAPI60.dll" (ByRef axis As String, ByVal angle As Double, ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWCreateHatch Lib "TCAPI60.dll" () As Long
Declare Function TCWGroupCreate Lib "TCAPI60.dll" (ByRef groupname As String) As Long
Declare Function TCWExplode Lib "TCAPI60.dll" () As Long
' justify
Declare Function TCWBringtoFront Lib "TCAPI60.dll" () As Long
Declare Function TCWSendtoBack Lib "TCAPI60.dll" () As Long
Declare Function TCWAlignBottom Lib "TCAPI60.dll" () As Long
Declare Function TCWAlignTop Lib "TCAPI60.dll" () As Long
Declare Function TCWAlignMiddle Lib "TCAPI60.dll" () As Long
Declare Function TCWAlignLeft Lib "TCAPI60.dll" () As Long
Declare Function TCWAlignRight Lib "TCAPI60.dll" () As Long
Declare Function TCWAlignCenter Lib "TCAPI60.dll" () As Long
' vertex functions
Declare Function TCWVertexCount Lib "TCAPI60.dll" (ByVal g As Long) As Long
Declare Function TCWVertexAt Lib "TCAPI60.dll" (ByVal g As Long, ByVal Index As Long) As Long
Declare Function TCWVertexCreate Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWVertexZero Lib "TCAPI60.dll" () As Long
Declare Function TCWVertexCopy Lib "TCAPI60.dll" (ByVal v As Long) As Long
Declare Function TCWVertexDispose Lib "TCAPI60.dll" (ByVal v As Long) As Long
Declare Function TCWVertexFindVertex Lib "TCAPI60.dll" (ByVal v As Long, ByVal osmode As Long) As Long

Declare Function TCWGetPoint Lib "TCAPI60.dll" (ByVal v As Long, ByVal Prompt As String, ByVal gd As Long, ByVal vd As Long, ByVal osmode As Long, ByVal cursor As Long) As Long
Declare Function TCWGetX Lib "TCAPI60.dll" (ByVal v As Long) As Double
Declare Function TCWSetX Lib "TCAPI60.dll" (ByVal v As Long, ByVal x0 As Double) As Long
Declare Function TCWGetY Lib "TCAPI60.dll" (ByVal v As Long) As Double
Declare Function TCWSetY Lib "TCAPI60.dll" (ByVal v As Long, ByVal y0 As Double) As Long
Declare Function TCWGetZ Lib "TCAPI60.dll" (ByVal v As Long) As Double
Declare Function TCWSetZ Lib "TCAPI60.dll" (ByVal v As Long, ByVal z0 As Double) As Long
Declare Function TCWSetXY Lib "TCAPI60.dll" (ByVal v As Long, ByVal x0 As Double, ByVal y0 As Double) As Long
Declare Function TCWSetXYZ Lib "TCAPI60.dll" (ByVal v As Long, ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double) As Long
Declare Function TCWPenDown Lib "TCAPI60.dll" (ByVal v As Long, ByVal state As Long) As Long
' view's functions
Declare Function TCWViewAt Lib "TCAPI60.dll" (ByVal Index As Long) As Long
Declare Function TCWViewCount Lib "TCAPI60.dll" () As Long
Declare Function TCWViewActive Lib "TCAPI60.dll" () As Long
Declare Function TCWViewRedraw Lib "TCAPI60.dll" () As Long
Declare Function TCWViewUpdateWindow Lib "TCAPI60.dll" () As Long
Declare Function TCWViewZoom Lib "TCAPI60.dll" () As Long
Declare Function TCWViewZoomIn Lib "TCAPI60.dll" () As Long
Declare Function TCWViewZoomOut Lib "TCAPI60.dll" () As Long
Declare Function TCWViewZoomPage Lib "TCAPI60.dll" () As Long
Declare Function TCWViewZoomExtents Lib "TCAPI60.dll" () As Long
Declare Function TCWViewZoomWindow Lib "TCAPI60.dll" (ByVal x0 As Double, ByVal y0 As Double, ByVal z0 As Double, ByVal x1 As Double, ByVal y1 As Double, ByVal z1 As Double) As Long
Declare Function TCWViewExtentsGetX1 Lib "TCAPI60.dll" () As Double
Declare Function TCWViewExtentsGetY1 Lib "TCAPI60.dll" () As Double
Declare Function TCWViewExtentsGetZ1 Lib "TCAPI60.dll" () As Double
Declare Function TCWViewExtentsGetX2 Lib "TCAPI60.dll" () As Double
Declare Function TCWViewExtentsGetY2 Lib "TCAPI60.dll" () As Double
Declare Function TCWViewExtentsGetZ2 Lib "TCAPI60.dll" () As Double
'layers functions
Declare Function TCWLayersCount Lib "TCAPI60.dll" () As Long
Declare Function TCWLayersAt Lib "TCAPI60.dll" (ByVal Index As Long) As Long
Declare Function TCWLayerCreate Lib "TCAPI60.dll" (ByRef lName As String, ByVal visible As Long, ByVal frozen As Long, ByVal readonly As Long, ByVal lColor As Long, ByVal lLineStyle As Long) As Long
Declare Function TCWLayerDispose Lib "TCAPI60.dll" (ByVal Index As Long) As Long
' File I/O functions
Declare Function TCWOpenInput Lib "TCAPI60.dll" (ByRef filename As String) As Long
Declare Function TCWReadInputToken Lib "TCAPI60.dll" (ByVal fd As Long, ByRef bstrtext As String) As Long
Declare Function TCWReadInput Lib "TCAPI60.dll" (ByVal fd As Long, ByRef bstrtext As String) As Long
Declare Function TCWCloseInput Lib "TCAPI60.dll" (ByVal fd As Long) As Long
Declare Function TCWOpenOutput Lib "TCAPI60.dll" (ByRef filename As String) As Long
Declare Function TCWWriteOutput Lib "TCAPI60.dll" (ByVal fd As Long, ByRef bstrBuffer As String) As Long
Declare Function TCWCloseOutput Lib "TCAPI60.dll" (ByVal fd As Long) As Long
' common

Declare Function TCWGetIntResult Lib "TCAPI60.dll" () As Integer
Declare Function TCWGetLongResult Lib "TCAPI60.dll" () As Long
Declare Function TCWGetDoubleResult Lib "TCAPI60.dll" () As Double
Declare Function TCWGetStringResult Lib "TCAPI60.dll" (ByRef tcwstr As String)

' properties
' App properties
'Declare Function TCWAppPropertyGet Lib "TCAPI60.dll" (ByRef propertyname As String) As Variant
'Declare Function TCWAppPropertySet Lib "TCAPI60.dll" (ByRef propertyname As String, ByVal value As Variant) As Long
Declare Function TCWAppPropertySetInt Lib "TCAPI60.dll" (ByRef tcwstr As String, ByVal tcwvalue As Integer) As Long
Declare Function TCWAppPropertySetLong Lib "TCAPI60.dll" (ByRef tcwstr As String, ByVal tcwvalue As Long) As Long
Declare Function TCWAppPropertySetDbl Lib "TCAPI60.dll" (ByRef tcwstr As String, ByVal tcwvalue As Double) As Long
Declare Function TCWAppPropertySetString Lib "TCAPI60.dll" (ByRef tcwstr As String, ByRef tcwvalue As String) As Long
Declare Function TCWAppPropertyGetX Lib "TCAPI60.dll" (ByRef tcwpropertyname As String) As Long

' drawing properties

Declare Function TCWDrawingPropertyGetX Lib "TCAPI60.dll" (ByRef tcwpropertyname As String) As Long

'Declare Function TCWDrawingPropertyGet Lib "TCAPI60.dll" (ByRef propertyname As String) As Variant
'Declare Function TCWDrawingPropertySet Lib "TCAPI60.dll" (ByRef propertyname As String, ByVal value As Variant) As Long

Declare Function TCWDrawingPropertySetInt Lib "TCAPI60.dll" (ByRef tcwstr As String, ByVal tcwvalue As Integer) As Long
Declare Function TCWDrawingPropertySetLong Lib "TCAPI60.dll" (ByRef tcwstr As String, ByVal tcwvalue As Long) As Long
Declare Function TCWDrawingPropertySetDbl Lib "TCAPI60.dll" (ByRef tcwstr As String, ByVal tcwvalue As Double) As Long
Declare Function TCWDrawingPropertySetString Lib "TCAPI60.dll" (ByRef tcwstr As String, ByRef tcwvalue As String) As Long

' graphic properties
Declare Function TCWGraphicPropertyGetX Lib "TCAPI60.dll" (ByVal tcwg As Long, ByRef tcwpropertyname As String) As Long
Declare Function TCWGraphicPropertySetInt Lib "TCAPI60.dll" (ByVal tcwg As Long, ByRef tcwstr As String, ByVal tcwvalue As Integer) As Long
Declare Function TCWGraphicPropertySetLong Lib "TCAPI60.dll" (ByVal tcwg As Long, ByRef tcwstr As String, ByVal tcwvalue As Long) As Long
Declare Function TCWGraphicPropertySetDbl Lib "TCAPI60.dll" (ByVal tcwg As Long, ByRef tcwstr As String, ByVal tcwvalue As Double) As Long
Declare Function TCWGraphicPropertySetString Lib "TCAPI60.dll" (ByVal tcwg As Long, ByRef tcwstr As String, ByRef tcwvalue As String) As Long

' Layer's functions
Declare Function TCWLayerPropertyGetX Lib "TCAPI60.dll" (ByVal tcwlayer As Long, ByRef tcwpropertyname As String) As Long

'Declare Function TCWLayerPropertyGet Lib "TCAPI60.dll" (ByVal layer As Long, ByRef propertyname As String) As Variant
'Declare Function TCWLayerPropertySet Lib "TCAPI60.dll" (ByVal layer As Long, ByRef propertyname As String, ByVal value As Variant) As Long
Declare Function TCWLayerPropertySetInt Lib "TCAPI60.dll" (ByVal tcwl As Long, ByRef tcwstr As String, ByVal tcwvalue As Integer) As Long
Declare Function TCWLayerPropertySetLong Lib "TCAPI60.dll" (ByVal tcwl As Long, ByRef tcwstr As String, ByVal tcwvalue As Long) As Long
Declare Function TCWLayerPropertySetString Lib "TCAPI60.dll" (ByVal tcwl As Long, ByRef tcwstr As String, ByRef tcwvalue As String) As Long
Function TCWGetResult(ByVal tcwret As Long) As Variant
Dim tcwResult As Variant
Dim tcwIType As Integer
Dim tcwDType As Double
Dim tcwLType As Long
Dim tcwSType As String

  If (tcwret = 0) Then
    tcwResult = 0
  ElseIf (tcwret = 2) Then
    tcwIType = TCWGetIntResult()
    tcwResult = tcwIType
  ElseIf (tcwret = 3) Then
    tcwLType = TCWGetLongResult()
    tcwResult = tcwLType
  ElseIf (tcwret = 5) Then
    tcwDType = TCWGetDoubleResult()
    tcwResult = tcwDType
  ElseIf (tcwret = 8) Then
    TCWGetStringResult tcwSType
    tcwResult = tcwSType
  ElseIf (tcwret = 11) Then
    tcwIType = TCWGetIntResult()
    tcwResult = tcwIType
  End If

  TCWGetResult = tcwResult
End Function

Function TCWLayerPropertySet(ByVal tcwl As Long, ByVal tcwstr As String, ByVal tcwvalue As Variant) As Long
  Dim tcwResult As Long
  Dim tcwRType As Long
  Dim tcwIType As Integer
  Dim tcwLType As Long
  Dim tcwSType As String
  Dim vt As Long

  vt = TCWLayerPropertyGetX(tcwl, tcwstr)
  If (vt = 2) Then
    tcwIType = tcwvalue
    tcwResult = TCWLayerPropertySetInt(tcwl, tcwstr, tcwIType)
  ElseIf (vt = 3) Then
    tcwLType = tcwvalue
    tcwResult = TCWLayerPropertySetLong(tcwl, tcwstr, tcwLType)
  ElseIf (vt = 8) Then
    tcwSType = tcwvalue
    tcwResult = TCWLayerPropertySetString(tcwl, tcwstr, tcwSType)
  ElseIf (vt = 11) Then
    tcwIType = tcwvalue
    tcwResult = TCWLayerPropertySetInt(tcwl, tcwstr, tcwIType)
  Else
    MsgBox "Property type " & vt & " not supported"
  End If

  TCWLayerPropertySet = tcwResult

End Function

Function TCWAppPropertyGet(ByVal tcwstr As String) As Variant
  Dim tcwResult As Variant
  Dim tcwRType As Long

  tcwRType = TCWAppPropertyGetX(tcwstr)
  tcwResult = TCWGetResult(tcwRType)
  TCWAppPropertyGet = tcwResult

End Function

Function TCWAppPropertySet(ByVal tcwstr As String, ByVal tcwvalue As Variant) As Long
  Dim tcwResult As Long
  Dim tcwRType As Long
  Dim tcwIType As Integer
  Dim tcwLType As Long
  Dim tcwDType As Double
  Dim tcwSType As String
  Dim vt As Long

  vt = TCWAppPropertyGetX(tcwstr)
  If (vt = 2) Then
    tcwIType = tcwvalue
    tcwResult = TCWAppPropertySetInt(tcwstr, tcwIType)
  ElseIf (vt = 3) Then
    tcwLType = tcwvalue
    tcwResult = TCWAppPropertySetLong(tcwstr, tcwLType)
  ElseIf (vt = 5) Then
    tcwDType = tcwvalue
    tcwResult = TCWAppPropertySetDbl(tcwstr, tcwDType)
  ElseIf (vt = 8) Then
    tcwSType = tcwvalue
    tcwResult = TCWAppPropertySetString(tcwstr, tcwSType)
  ElseIf (vt = 11) Then
    tcwIType = tcwvalue
    tcwResult = TCWAppPropertySetInt(tcwstr, tcwIType)
  Else
    MsgBox "Property type " & vt & " not supported"
  End If

  TCWAppPropertySet = tcwResult

End Function

Function TCWDrawingPropertyGet(ByVal tcwstr As String) As Variant
  Dim tcwResult As Variant
  Dim tcwRType As Long

  tcwRType = TCWDrawingPropertyGetX(tcwstr)
  tcwResult = TCWGetResult(tcwRType)
  TCWDrawingPropertyGet = tcwResult

End Function

Function TCWDrawingPropertySet(ByVal tcwstr As String, ByVal tcwvalue As Variant) As Long
  Dim tcwResult As Long
  Dim tcwRType As Long
  Dim tcwIType As Integer
  Dim tcwLType As Long
  Dim tcwDType As Double
  Dim tcwSType As String
  Dim vt As Long

  vt = TCWDrawingPropertyGetX(tcwstr)
  If (vt = 2) Then
    tcwIType = tcwvalue
    tcwResult = TCWDrawingPropertySetInt(tcwstr, tcwIType)
  ElseIf (vt = 3) Then
    tcwLType = tcwvalue
    tcwResult = TCWDrawingPropertySetLong(tcwstr, tcwLType)
  ElseIf (vt = 5) Then
    tcwDType = tcwvalue
    tcwResult = TCWDrawingPropertySetDbl(tcwstr, tcwDType)
  ElseIf (vt = 8) Then
    tcwSType = tcwvalue
    tcwResult = TCWDrawingPropertySetString(tcwstr, tcwSType)
  ElseIf (vt = 11) Then
    tcwIType = tcwvalue
    tcwResult = TCWDrawingPropertySetInt(tcwstr, tcwIType)
  Else
    MsgBox "Property type " & vt & " not supported"
  End If

  TCWDrawingPropertySet = tcwResult

End Function

Function TCWGraphicPropertyGet(ByVal tcwg As Long, ByVal tcwstr As String) As Variant
  Dim tcwResult As Variant
  Dim tcwRType As Long

  tcwRType = TCWGraphicPropertyGetX(tcwg, tcwstr)
  tcwResult = TCWGetResult(tcwRType)
  TCWGraphicPropertyGet = tcwResult

End Function
Function TCWGraphicPropertySet(ByVal tcwg As Long, ByVal tcwstr As String, ByVal tcwvalue As Variant) As Long
  Dim tcwResult As Long
  Dim tcwRType As Long
  Dim tcwIType As Integer
  Dim tcwLType As Long
  Dim tcwDType As Double
  Dim tcwSType As String
  Dim vt As Long

  vt = TCWGraphicPropertyGetX(tcwg, tcwstr)
  If (vt = 2) Then
    tcwIType = tcwvalue
    tcwResult = TCWGraphicPropertySetInt(tcwg, tcwstr, tcwIType)
  ElseIf (vt = 3) Then
    tcwLType = tcwvalue
    tcwResult = TCWGraphicPropertySetLong(tcwg, tcwstr, tcwLType)
  ElseIf (vt = 5) Then
    tcwDType = tcwvalue
    tcwResult = TCWGraphicPropertySetDbl(tcwg, tcwstr, tcwDType)
  ElseIf (vt = 8) Then
    tcwSType = tcwvalue
    tcwResult = TCWGraphicPropertySetString(tcwg, tcwstr, tcwSType)
  ElseIf (vt = 11) Then
    tcwIType = tcwvalue
    tcwResult = TCWGraphicPropertySetInt(tcwg, tcwstr, tcwIType)
  Else
    MsgBox "Property type " & vt & " not supported"
  End If

  TCWGraphicPropertySet = tcwResult

End Function

Function TCWLayerPropertyGet(ByVal tcwl As Long, ByVal tcwstr As String) As Variant
  Dim tcwResult As Variant
  Dim tcwRType As Long

  tcwRType = TCWLayerPropertyGetX(tcwl, tcwstr)
  tcwResult = TCWGetResult(tcwRType)

  TCWLayerPropertyGet = tcwResult

End Function


Examples - ctlTcViewer.ctl

ctlTcViewer.ctl

VERSION 5.00
Begin VB.UserControl ctlTcViewer
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   4320
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4716
   ControlContainer=   -1  'True
   KeyPreview      =   -1  'True
   ScaleHeight     =   360
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   393
End
Attribute VB_Name = "ctlTcViewer"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Public Event ClickGraphic(gxGr As Graphic, dist As Double)

Dim gxDwg As Drawing
Dim gxVw  As View
Dim bAttached As Boolean
Dim dblAperture As Double
Dim bUpdate As Boolean

Public Sub Refresh()
    Cls
    If (bAttached) Then
        If (bUpdate) Then
            gxVw.Refresh
        End If
    End If
End Sub

Public Sub Scroll(dy As Long, dx As Long)

    If (bAttached) Then

        On Error GoTo VwZoom
         gxVw.Camera.Slide gxVw.ViewHeight() * dy / 10, gxVw.ViewWidth() * dx / 10
        Exit Sub
VwZoom:
        Dim yTop As Double
        Dim xLeft As Double

        On Error GoTo Err

        xLeft = gxVw.ViewLeft + gxVw.ViewWidth() * dx / 10
        yTop = gxVw.ViewTop - gxVw.ViewHeight() * dy / 10

        gxVw.Update = False

        gxVw.ViewLeft = xLeft
        gxVw.ViewTop = yTop

    End If
Err:
End Sub

Public Sub Zoom(factor As Double)

    If (bAttached) Then
        If (factor <> 0) Then
            On Error GoTo VwZoom
            gxVw.Camera.Zoom factor
            Exit Sub

        Else
            gxVw.ZoomToExtents
        End If
    End If
    Exit Sub
VwZoom:
        Dim xC As Double
        Dim yC As Double

        Dim w As Double
        Dim h As Double

        On Error GoTo Err
        w = gxVw.ViewWidth
        h = gxVw.ViewHeight

        xC = gxVw.ViewLeft + w / 2
        yC = gxVw.ViewTop - h / 2

        w = w * factor
        h = h * factor

        gxVw.Update = False

        gxVw.ViewLeft = xC - w / 2
        gxVw.ViewTop = yC + h / 2

        gxVw.ViewWidth = w
        gxVw.ViewHeight = h
Err:
End Sub

Public Function Detach() As Boolean

    On Error Resume Next
    If (Not gxVw Is Nothing) Then
        gxVw.Delete
        Set gxVw = Nothing
    End If

    If (Not gxDwg Is Nothing) Then
        Set gxDwg = Nothing
    End If
    bAttached = False

    Detach = bAttached

End Function
Public Function Attach(objDwg As Object) As Boolean

    Dim gxProps As Properties
    Dim gxProp As Property

    On Error GoTo Err

    Detach

    Set gxDwg = objDwg
    Set gxProps = gxDwg.Application.Properties
    Set gxProp = gxProps("Aperture")

    dblAperture = gxProp

    Set gxProp = Nothing
    Set gxProps = Nothing

    Set gxVw = gxDwg.Views.Add(hWnd)
    gxVw.ZoomToExtents

    bAttached = True

Err:
    If (Err <> 0) Then
        MsgBox Err.Description
    End If

    Attach = bAttached
End Function

Private Sub UserControl_Initialize()
    bAttached = False
    bUpdate = True
    Set gxVw = Nothing
    Set gxDwg = Nothing
    dblAperture = 1
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    Dim xVw As Double
    Dim yVw As Double
    Dim xW As Double
    Dim yW As Double
    Dim zW As Double

    Dim gxPickRes As PickResult
    Dim gxPickEntry As PickEntry
    Dim cnt As Long
    Dim ind As Long

    If (bAttached) Then

        gxVw.ScreenToView X, Y, xVw, yVw

        Set gxPickRes = gxVw.PickPoint(xVw, yVw, dblAperture, True, True, True, True, True, False)

        cnt = gxPickRes.Count - 1
        For ind = 0 To cnt
            Set gxPickEntry = gxPickRes.Item(ind)
            RaiseEvent ClickGraphic(gxPickEntry.Graphic, gxPickEntry.Distance)
        Next ind

    End If

    Set gxPickEntry = Nothing
    Set gxPickRes = Nothing

    Refresh
End Sub

Private Sub UserControl_Paint()
    If (bAttached And bUpdate) Then
        On Error Resume Next
        gxVw.Refresh
    End If
End Sub

Private Sub UserControl_Terminate()

    Detach

End Sub

Public Property Get ViewSpace() As Variant
    If (Not gxVw Is Nothing) Then
        ViewSpace = gxVw.SpaceMode
    End If
End Property

Public Property Let ViewSpace(ByVal vNewValue As Variant)
    Dim bSpace As ImsiSpaceModeType
    bSpace = vNewValue
    If (Not gxVw Is Nothing) Then
        gxVw.SpaceMode = bSpace
        gxVw.Refresh
    End If
End Property

Public Property Get Aperture() As Variant
    Aperture = dblAperture
End Property

Public Property Let Aperture(ByVal vNewValue As Variant)
    dblAperture = vNewValue
End Property

Public Property Get Update() As Variant
    Update = bUpdate
End Property

Public Property Let Update(ByVal vNewValue As Variant)
    bUpdate = vNewValue
End Property


Examples - frmCADGX.frm

frmCADGX.frm

VERSION 5.00
Object = "{28ABE54C-5D72-11D4-9C78-00C0DF246524}#1.2#0"; "TcViewer.ocx"
Begin VB.Form frmCADGX
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "TurboCAD SDK Client sample application"
   ClientHeight    =   7116
   ClientLeft      =   36
   ClientTop       =   264
   ClientWidth     =   10584
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   7116
   ScaleWidth      =   10584
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton btnSetAperture2
      Caption         =   "Set"
      Height          =   300
      Left            =   8760
      TabIndex        =   29
      Top             =   5268
      Width           =   1428
   End
   Begin VB.CommandButton btnSetAperture1
      Caption         =   "Set"
      Height          =   300
      Left            =   3480
      TabIndex        =   28
      Top             =   5268
      Width           =   1428
   End
   Begin VB.TextBox txtAperture2
      Height          =   288
      Left            =   7968
      TabIndex        =   26
      Top             =   5280
      Width           =   732
   End
   Begin VB.TextBox txtAperture1
      Height          =   288
      Left            =   2688
      TabIndex        =   24
      Top             =   5268
      Width           =   732
   End
   Begin VB.CommandButton btnNew2
      Caption         =   "New Drawing"
      Height          =   372
      Left            =   5772
      TabIndex        =   23
      Top             =   6096
      Width           =   1452
   End
   Begin VB.CommandButton btnNew1
      Caption         =   "New Drawing"
      Height          =   372
      Left            =   468
      TabIndex        =   22
      Top             =   6132
      Width           =   1452
   End
   Begin prjTcViewer.ctlTcViewer ctlTcViewer2
      Height          =   4812
      Left            =   5760
      TabIndex        =   21
      Top             =   120
      Width           =   4452
      _ExtentX        =   7853
      _ExtentY        =   8488
   End
   Begin prjTcViewer.ctlTcViewer ctlTcViewer1
      Height          =   4812
      Left            =   480
      TabIndex        =   20
      Top             =   120
      Width           =   4452
      _ExtentX        =   7853
      _ExtentY        =   8488
   End
   Begin VB.CommandButton btnSpace2
      Height          =   252
      Left            =   10200
      TabIndex        =   19
      Top             =   4920
      Width           =   252
   End
   Begin VB.CommandButton btnSpace1
      Height          =   252
      Left            =   240
      TabIndex        =   18
      Top             =   4920
      Width           =   252
   End
   Begin VB.CommandButton btnZoomIn2
      Caption         =   "Zoom In"
      Height          =   372
      Left            =   5772
      TabIndex        =   17
      Top             =   5652
      Width           =   1452
   End
   Begin VB.CommandButton btnZoomAll2
      Caption         =   "Zoom All"
      Height          =   372
      Left            =   7272
      TabIndex        =   16
      Top             =   5664
      Width           =   1452
   End
   Begin VB.CommandButton btnZoomOut2
      Caption         =   "Zoom Out"
      Height          =   372
      Left            =   8772
      TabIndex        =   15
      Top             =   5676
      Width           =   1452
   End
   Begin VB.CommandButton btnZoomIn1
      Caption         =   "Zoom In"
      Height          =   372
      Left            =   480
      TabIndex        =   14
      Top             =   5652
      Width           =   1452
   End
   Begin VB.CommandButton btnZoomAll1
      Caption         =   "Zoom All"
      Height          =   372
      Left            =   3480
      TabIndex        =   13
      Top             =   5652
      Width           =   1452
   End
   Begin VB.CommandButton btnZoomOut1
      Caption         =   "Zoom Out"
      Height          =   372
      Left            =   1980
      TabIndex        =   12
      Top             =   5652
      Width           =   1452
   End
   Begin VB.CommandButton btnCopy21
      Caption         =   "<-"
      Height          =   372
      Left            =   5040
      TabIndex        =   11
      Top             =   2400
      Width           =   612
   End
   Begin VB.CommandButton btncCopy12
      Caption         =   "->"
      Height          =   372
      Left            =   5040
      TabIndex        =   10
      Top             =   1920
      Width           =   612
   End
   Begin VB.HScrollBar HScroll1
      Height          =   252
      Left            =   480
      Max             =   10
      TabIndex        =   9
      Top             =   4920
      Value           =   5
      Width           =   4452
   End
   Begin VB.HScrollBar HScroll2
      Height          =   252
      Left            =   5760
      Max             =   10
      TabIndex        =   8
      Top             =   4920
      Value           =   5
      Width           =   4452
   End
   Begin VB.VScrollBar VScroll2
      Height          =   4812
      Left            =   10200
      Max             =   10
      TabIndex        =   7
      Top             =   120
      Value           =   5
      Width           =   252
   End
   Begin VB.VScrollBar VScroll1
      Height          =   4812
      Left            =   240
      Max             =   10
      TabIndex        =   6
      Top             =   120
      Value           =   5
      Width           =   252
   End
   Begin VB.CommandButton btnSave2
      Caption         =   "Save Drawing"
      Height          =   372
      Left            =   7272
      TabIndex        =   5
      Top             =   6576
      Width           =   1452
   End
   Begin VB.CommandButton btnClose2
      Caption         =   "Close Drawing"
      Height          =   372
      Left            =   8772
      TabIndex        =   4
      Top             =   6108
      Width           =   1452
   End
   Begin VB.CommandButton btnOpen2
      Caption         =   "Open Drawing"
      Height          =   372
      Left            =   7272
      TabIndex        =   3
      Top             =   6096
      Width           =   1452
   End
   Begin VB.CommandButton btnSave
      Caption         =   "Save Drawing"
      Height          =   372
      Left            =   1956
      TabIndex        =   2
      Top             =   6600
      Width           =   1452
   End
   Begin VB.CommandButton btnClose1
      Caption         =   "Close Drawing"
      Height          =   372
      Left            =   3480
      TabIndex        =   1
      Top             =   6144
      Width           =   1452
   End
   Begin VB.CommandButton btnOpen1
      Caption         =   "Open Drawing"
      Height          =   372
      Left            =   1968
      TabIndex        =   0
      Top             =   6132
      Width           =   1440
   End
   Begin VB.Label Label2
      Caption         =   "Select  Aperture:"
      Height          =   276
      Left            =   6612
      TabIndex        =   27
      Top             =   5292
      Width           =   1212
   End
   Begin VB.Label Label1
      Caption         =   "Select  Aperture:"
      Height          =   216
      Left            =   1332
      TabIndex        =   25
      Top             =   5280
      Width           =   1212
   End
End
Attribute VB_Name = "frmCADGX"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim gxApp As New XApplication

Dim gxDwg1 As Drawing
Dim gxDwg2 As Drawing

Private Sub CloseDrawing1()

    ctlTcViewer1.Detach
    ctlTcViewer1.Refresh
    If (Not gxDwg1 Is Nothing) Then
        gxDwg1.Close
        Set gxDwg1 = Nothing
    End If
    btnSpace1.Caption = ""
    txtAperture1 = ""

End Sub

Private Sub CloseDrawing2()

    ctlTcViewer2.Detach
    ctlTcViewer2.Refresh
    If (Not gxDwg2 Is Nothing) Then
        gxDwg2.Close
        Set gxDwg2 = Nothing
    End If
    btnSpace2.Caption = ""
    txtAperture2 = ""

End Sub

Private Sub OpenDrawing1(strFilePath As String)

    CloseDrawing1

    If (strFilePath <> "") Then
        Set gxDwg1 = gxApp.Drawings.Open(strFilePath)
    Else
        Set gxDwg1 = gxApp.Drawings.Add
    End If
    ctlTcViewer1.Attach gxDwg1

    If (ctlTcViewer1.ViewSpace) Then
        btnSpace1.Caption = "M"
    Else
        btnSpace1.Caption = "P"
    End If

    txtAperture1 = CStr(ctlTcViewer1.Aperture)
End Sub

Private Sub OpenDrawing2(strFilePath As String)

    CloseDrawing2

    On Error GoTo Err
    If (strFilePath <> "") Then
        Set gxDwg2 = gxApp.Drawings.Open(strFilePath)
    Else
        Set gxDwg2 = gxApp.Drawings.Add
    End If
    ctlTcViewer2.Attach gxDwg2

    If (ctlTcViewer2.ViewSpace) Then
        btnSpace2.Caption = "M"
    Else
        btnSpace2.Caption = "P"
    End If

    txtAperture2 = CStr(ctlTcViewer2.Aperture)
    Exit Sub
Err:
    If (Err.Number <> 0) Then
        MsgBox Err.Description
    End If
End Sub

Private Sub btncCopy12_Click()

    Dim gxGrSel As Graphic
    Dim gxSel As Selection

    On Error GoTo ErrHandler

    ctlTcViewer2.Update = False

    Set gxSel = gxDwg1.Selection
    For Each gxGrSel In gxSel
        MergeGraphic gxGrSel, gxDwg1, gxDwg2
    Next gxGrSel

ErrHandler:
    ctlTcViewer2.Update = True

    Set gxGrSel = Nothing
    Set gxSel = Nothing

End Sub

Private Sub btnClose1_Click()
    CloseDrawing1
End Sub

Private Sub btnClose2_Click()
    CloseDrawing2
End Sub

Private Sub btnCopy21_Click()

    Dim gxGrSel As Graphic
    Dim gxSel As Selection

    ctlTcViewer1.Update = False

    Set gxSel = gxDwg2.Selection
    For Each gxGrSel In gxSel
        MergeGraphic gxGrSel, gxDwg2, gxDwg1
    Next gxGrSel

    ctlTcViewer1.Update = True

ErrHandler:
    Set gxGrSel = Nothing
    Set gxSel = Nothing

End Sub

Private Sub btnNew1_Click()
    OpenDrawing1 ""
End Sub

Private Sub btnNew2_Click()
    OpenDrawing2 ""
End Sub

Private Sub btnOpen1_Click()

    On Error GoTo Err

    OpenDrawing1 gxApp.GetOpenFilename

Err:
End Sub

Private Sub btnOpen2_Click()
    On Error GoTo Err

    OpenDrawing2 gxApp.GetOpenFilename

Err:

End Sub

Private Sub btnSave_Click()

    On Error GoTo Err

    gxDwg1.SaveAs gxApp.GetSaveFilename
Err:
End Sub

Private Sub btnSave2_Click()
    On Error GoTo Err

    gxDwg2.SaveAs gxApp.GetSaveFilename

Err:
End Sub

Private Sub btnSetAperture1_Click()

    ctlTcViewer1.Aperture = CDbl(txtAperture1)

End Sub

Private Sub btnSetAperture2_Click()
    ctlTcViewer2.Aperture = CDbl(txtAperture2)
End Sub

Private Sub btnSpace1_Click()

    On Error GoTo ErrHandler

    If (ctlTcViewer1.ViewSpace) Then
        btnSpace1.Caption = "P"
        ctlTcViewer1.ViewSpace = 0
    Else
        btnSpace1.Caption = "M"
        ctlTcViewer1.ViewSpace = 1
    End If

    ctlTcViewer1.Zoom 0
    ctlTcViewer1.Refresh

ErrHandler:

End Sub

Private Sub btnSpace2_Click()

    On Error GoTo ErrHandler

    If (ctlTcViewer2.ViewSpace) Then
        btnSpace2.Caption = "P"
        ctlTcViewer2.ViewSpace = 0
    Else
        btnSpace2.Caption = "M"
        ctlTcViewer2.ViewSpace = 1
    End If

    ctlTcViewer2.Zoom 0
    ctlTcViewer2.Refresh

ErrHandler:

End Sub

Private Sub btnZoomAll1_Click()
    ctlTcViewer1.Zoom 0
    ctlTcViewer1.Refresh
End Sub

Private Sub btnZoomIn1_Click()
    ctlTcViewer1.Zoom 1 / 1.25
    ctlTcViewer1.Refresh
End Sub

Private Sub btnZoomOut1_Click()
    ctlTcViewer1.Zoom 1.25
    ctlTcViewer1.Refresh
End Sub

Private Sub btnZoomAll2_Click()
    ctlTcViewer2.Zoom 0
    ctlTcViewer2.Refresh
End Sub

Private Sub btnZoomIn2_Click()
    ctlTcViewer2.Zoom 1 / 1.25
    ctlTcViewer2.Refresh
End Sub

Private Sub btnZoomOut2_Click()
    ctlTcViewer2.Zoom 1.25
    ctlTcViewer2.Refresh
End Sub

Private Sub ctlTcViewer1_ClickGraphic(gxGr As IMSIGX.IGraphic, dist As Double)
    Dim gxGrSel As Graphic
    Dim gxSel As Selection

    Set gxSel = gxDwg1.Selection

    For Each gxGrSel In gxSel
        If (gxGrSel.ID = gxGr.ID) Then
            gxGrSel.Unselect
            GoTo Done
        End If
    Next gxGrSel
    gxGr.Select

Done:

    Set gxGrSel = Nothing
    Set gxSel = Nothing

End Sub

Private Sub ctlTcViewer2_ClickGraphic(gxGr As IMSIGX.IGraphic, dist As Double)

    Dim gxGrSel As Graphic
    Dim gxSel As Selection
    Set gxSel = gxDwg2.Selection

    For Each gxGrSel In gxSel
        If (gxGrSel.ID = gxGr.ID) Then
            gxGrSel.Unselect
            GoTo Done
        End If
    Next gxGrSel
    gxGr.Select

Done:

    Set gxGrSel = Nothing
    Set gxSel = Nothing

End Sub

Private Sub Form_Unload(Cancel As Integer)
    CloseDrawing1
    CloseDrawing2
    Set gxApp = Nothing
End Sub

Private Sub HScroll1_Change()

    Dim dx As Long

    dx = HScroll1.Value - 5

    If (dx <> 0) Then
        ctlTcViewer1.Scroll 0, dx
        HScroll1.Value = 5
    End If

    ctlTcViewer1.Refresh

End Sub

Private Sub VScroll1_Change()

    Dim dy As Long

    dy = VScroll1.Value - 5

    If (dy <> 0) Then
        ctlTcViewer1.Scroll dy, 0
        VScroll1.Value = 5
    End If

    ctlTcViewer1.Refresh

End Sub

Private Sub HScroll2_Change()

    Dim dx As Long

    dx = HScroll2.Value - 5

    If (dx <> 0) Then
        ctlTcViewer2.Scroll 0, dx
        HScroll2.Value = 5
    End If

    ctlTcViewer2.Refresh

End Sub

Private Sub VScroll2_Change()

    Dim dy As Long

    dy = VScroll2.Value - 5

    If (dy <> 0) Then
        ctlTcViewer2.Scroll dy, 0
        VScroll2.Value = 5
    End If

    ctlTcViewer2.Refresh

End Sub


Examples - mMerge.bas

mMerge.bas

Attribute VB_Name = "mMerge"
Option Explicit

Dim gxStylesSrc   As Styles
Dim gxLStylesSrc  As LineStyles
Dim gxBStylesSrc  As BrushStyles
Dim gxLyrsSrc     As Layers
Dim gxBlocksSrc   As Blocks
Dim gxDwgSrc As Drawing

Dim gxStylesTrg   As Styles
Dim gxLStylesTrg  As LineStyles
Dim gxBStylesTrg  As BrushStyles
Dim gxLyrsTrg     As Layers
Dim gxBlocksTrg   As Blocks
Dim gxDwgTrg As Drawing

Private Function MergeLStyle(gxLStyleSrc As LineStyle) As LineStyle
    Dim strName As String
    Dim varDashes As Variant

    Dim gxLStyle As LineStyle

    strName = gxLStyleSrc.Name
    On Error GoTo AddLStyle
    Set gxLStyle = gxLStylesTrg.Item(strName)
OK:
    Set MergeLStyle = gxLStyle
    Exit Function
AddLStyle:
    On Error GoTo ErrHandler
    gxLStyleSrc.GetDashes varDashes
    Set gxLStyle = gxLStylesTrg.Add(strName, varDashes)
    GoTo OK
ErrHandler:
    If Err.Description <> "" Then
        MsgBox Err.Description
    End If
End Function

Private Function MergeBStyle(gxBStyleSrc As BrushStyle) As BrushStyle
    Dim strName As String

    Dim gxBStyle As BrushStyle

    strName = gxBStyleSrc.Name
    On Error GoTo AddBStyle
    Set gxBStyle = gxBStylesTrg.Item(strName)
OK:
    Set MergeBStyle = gxBStyle
    Exit Function
AddBStyle:
    On Error GoTo ErrHandler
    ' sorry but it is impossible for now to add brush style with
    ' custom hatch style or patterns or etc
'    Set gxBStyle = gxBStylesTrg.Add(strName, ...)
    Set gxBStyle = gxBStylesTrg("SOLID")
    GoTo OK
ErrHandler:
    If Err.Description <> "" Then
        MsgBox Err.Description
    End If
End Function

Private Function MergeLayer(gxLyrSrc As Layer) As Layer

    Dim strName As String
    Dim gxLStyle As LineStyle
    Dim gxBStyle As BrushStyle

    Dim gxLyr As Layer

    On Error Resume Next
    Set gxLStyle = MergeLStyle(gxLyrSrc.LineStyle)
    Set gxBStyle = MergeBStyle(gxLyrSrc.BrushStyle)

    strName = gxLyrSrc.Name
    On Error GoTo AddLyr
    Set gxLyr = gxLyrsTrg.Item(strName)
    Set gxLyr.LineStyle = gxLStyle
    Set gxLyr.BrushStyle = gxBStyle
OK:
    Set MergeLayer = gxLyr
    Exit Function
AddLyr:
    On Error GoTo ErrHandler

    Set gxLyr = gxLyrsTrg.Add(strName _
                             , gxLyrSrc.Visible _
                             , gxLyrSrc.Editable _
                             , gxLyrSrc.Frozen _
                             , gxLyrSrc.Color _
                             , gxLStyle _
                             , gxBStyle _
                             , _
                             , gxLyrSrc.ZOrder)

    GoTo OK

ErrHandler:
    If Err.Description <> "" Then
        MsgBox Err.Description
    End If

End Function

Private Function MergeBlock(gxBlkSrc As Block) As Block

    Dim gxBlkTrg As Block
    Dim gxVrtAnchor As Vertex
    Dim gxGrSrc As Graphic
    Dim gxGrsSrc As Graphics
    Dim gxGrTrg As Graphic
    Dim strName As String

    Dim varX As Variant
    Dim varY As Variant
    Dim varZ As Variant

    Dim varTileModeOld As Variant

    varX = 0
    varY = 0
    varZ = 0

    strName = gxBlkSrc.Name
    On Error GoTo AddBlk1
    Set gxBlkTrg = gxBlocksTrg.Item(strName)
OK:
    Set MergeBlock = gxBlkTrg
    Exit Function

AddBlk1:
    varTileModeOld = gxDwgTrg.Properties("TileMode")
    gxDwgTrg.Properties("TileMode") = 1

    On Error GoTo AddBlk2
    Set gxVrtAnchor = gxBlkSrc.Anchor
    On Error GoTo ErrHandler

    varX = gxVrtAnchor.X
    varY = gxVrtAnchor.Y
    varZ = gxVrtAnchor.Z

AddBlk2:
    On Error GoTo ErrHandler

    Set gxGrsSrc = gxBlkSrc.Graphics
    Set gxGrSrc = gxGrsSrc
    Set gxGrTrg = gxGrSrc.Duplicate()
    gxDwgTrg.Graphics.AddGraphic gxGrTrg

    CorrectGraphic gxGrTrg, gxGrSrc

    gxBlocksTrg.Add strName, gxGrTrg, varX, varY, varZ
    gxGrTrg.Delete

    gxDwgTrg.Properties("TileMode") = varTileModeOld
    GoTo OK
ErrHandler:
    If Err.Description <> "" Then
        MsgBox Err.Description
    End If

End Function

Private Sub CorrectGraphic(gxGr As Graphic, gxGrSrc As Graphic)

    Dim gxGrChild   As Graphic
    Dim gxGrs       As Graphics
    Dim gxBlk       As Block
    Dim gxLStyle As LineStyle
    Dim gxBStyle As BrushStyle
    Dim gxLyr As Layer
    Dim ind As Long

    On Error Resume Next

    If (gxGr.Builtin) Then
        ind = 0
        Set gxGrs = gxGr.Graphics
        For Each gxGrChild In gxGrs
            CorrectGraphic gxGrChild, gxGrSrc.Graphics(ind)
            ind = ind + 1
        Next gxGrChild
    End If

    Set gxLyr = MergeLayer(gxGrSrc.Layer)
    Set gxLStyle = MergeLStyle(gxGrSrc.LineStyle)
    Set gxBStyle = MergeBStyle(gxGrSrc.BrushStyle)

    If (gxGr.TypeByValue = imsiInsert) Then
        Set gxBlk = MergeBlock(gxGrSrc.Block)
        gxGr.Block = gxBlk
    End If

    gxGr.Layer = gxLyr
    gxGr.LineStyle = gxLStyle
    gxGr.BrushStyle = gxBStyle

End Sub

Public Sub MergeGraphic(gxGr As Graphic, gxDwgFrom As Drawing, gxDwgTo As Drawing)

    Dim gxGrTrg As Graphic

    Set gxDwgSrc = gxDwgFrom
    Set gxDwgTrg = gxDwgTo

    On Error GoTo Done
    Set gxLStylesSrc = gxDwgSrc.LineStyles
    Set gxBStylesSrc = gxDwgSrc.BrushStyles
    Set gxLyrsSrc = gxDwgSrc.Layers
    Set gxBlocksSrc = gxDwgSrc.Blocks

    Set gxLStylesTrg = gxDwgTrg.LineStyles
    Set gxBStylesTrg = gxDwgTrg.BrushStyles
    Set gxLyrsTrg = gxDwgTrg.Layers
    Set gxBlocksTrg = gxDwgTrg.Blocks

    Set gxGrTrg = gxDwgSrc.Graphics.Remove(gxGr.Duplicate().Index)
    gxGrTrg.ID = 0
    gxDwgTrg.Graphics.AddGraphic gxGrTrg

    CorrectGraphic gxGrTrg, gxGr

Done:
    Set gxLStylesSrc = Nothing
    Set gxBStylesSrc = Nothing
    Set gxLyrsSrc = Nothing
    Set gxBlocksSrc = Nothing

    Set gxDwgSrc = Nothing

    Set gxLStylesTrg = Nothing
    Set gxBStylesTrg = Nothing
    Set gxLyrsTrg = Nothing
    Set gxBlocksTrg = Nothing

    Set gxDwgTrg = Nothing

End Sub


Examples - %%PROJECT_NAME%%Excel.cls

Excel.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ExExport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2000                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
'local variable(s) to hold property value(s)
Private mvarClassID As String 'local copy
Private mvarDescription As String 'local copy
Private mvarInfo As String 'local copy
Private mvarLastError As String 'local copy
Dim ExApp As Excel.Application
Dim pWbs As Workbooks
Dim pWb As Workbook
Dim pWss As Worksheets
Dim pWs As Worksheet
Private Init1 As Boolean
Dim GraphicsCount As Long
Dim Grs As Graphics
Public Property Get Info() As String
        Info = "MSEExport.ExExport,Microsoft Excel File,0,10,xls,xls"
End Property

Public Function Initialize(ByVal ThisFilter As Object) As Boolean
    Initialize = True
End Function

Public Function WriteSetup(ByVal ThisFilter As Object) As Boolean
    MsgBox "Add your code here !"
End Function

Public Function WriteFlat(ByVal FileName As String, ByVal Aspect As Long, ByVal Graphics As Object, Optional Query As Variant) As Long
On Error GoTo ExcelWontInit
    Set ExApp = CreateObject("Excel.Application")
    Set pWbs = ExApp.Workbooks
    Set pWb = pWbs.Add
    Set pWs = pWb.Worksheets(1) '.Add
    Set Grs = Graphics
    GraphicsCount = Grs.Count

    Call Fill_Sheet(pWs, "Graphic's properties")

    Set Grs = Nothing
    pWb.SaveAs FileName ', , , , , , xlShared
    pWb.Close
    pWbs.Close

    ExApp.Quit

    Set pWs = Nothing
    Set pWb = Nothing
    Set pWbs = Nothing
    Set ExApp = Nothing
    'MsgBox "Success !"
    Exit Function
ExcelWontInit:
    MsgBox "Can't initiaize Excel Application. Probably there is not Excel installed !"
    MsgBox Err.Description
    Err.Clear
    ExApp.Quit

    Set pWs = Nothing
    Set pWb = Nothing
    Set pWbs = Nothing
    Set ExApp = Nothing
End Function
'Public Function ReadSetup(ByVal ThisFilter As Object) As Boolean
'End Function

''Public Function ReadFlat(ByVal FileName As String, ByVal Aspect As Long, ByVal Graphics As Object, Optional Query As Variant) As Long
'    ReadFlat = False
'End Function

Public Function PreviewFlat(ByVal ThisFilter As Object, ByVal FileName As String, ByVal WidthA As Long, ByVal HeightA As Long, Description As String, Thumbnail As Variant) As Long
    PreviewFlat = -1
End Function

Public Function CheckFlat(ByVal ThisFilter As Object, ByVal FileName As String, ByVal Aspect As Long, ByVal Query As Variant) As Long
End Function

Public Property Get LastError() As String
Attribute LastError.VB_Description = "Get"
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.LastError
    LastError = mvarLastError
End Property

' GetInfo:  return the filter's info string
' Our info string is "MSEExport.Excel,Microsoft Excel File,0,10,xls,xls", stored in the DLL's
' resource.

' The info string contains the following fields, delimited by commas:
' Field Name                                Value
' 1.    Filter ID                           "MSEExport.Excel"
' the Filter ID must contains 32 symbols not more'
' otherwise your custom filter will not registered properly by turboCAD
'        Used as the internal name (must be unique).
'        Should be the same as the ProgID registered for the server.
'        TurboCAD reserves names beginning with an asterisk.
' 2.    File type string for common dialog  "Microsoft Excel File";
'        This string appears in Windows dialog file type combo box.
' 3.    Document type handled by filter     0
'        This should always be zero for automation filters.
' 4.    Priority                            10
'        Arbitrary integer value used to determine search order for multiple filters which
'        support the same document type and file extension.
' 5.    Exported function name prefix       "xls"
'        Not used by automation filters, but a non-blank string must be supplied.
' 6-n.  File extensions                     "xls"
'        Used in common dialog and for matching.

Public Property Get Description() As String
Attribute Description.VB_Description = "Get"
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Description
    Description = mvarDescription
End Property

Public Property Get ClassID() As String
Attribute ClassID.VB_Description = "Get"
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.ClassID
    ClassID = mvarClassID
End Property
Private Sub Fill_Sheet(W As Worksheet, SheetName As String)

    Dim DD() As String
    Dim i As Long
    Dim j As Long
    Dim Gr As Graphic
    i = 0
    j = 0

    W.Name = SheetName '"Graphic's properties"

    ReDim DD(GraphicsCount, 5)
    DD(0, 0) = "GraphicType"
    DD(0, 1) = "GraphicInfo"
    DD(0, 2) = "PenColor"
    DD(0, 3) = "PenStyle"
    DD(0, 4) = "Layer"
    DD(0, 5) = "GraphicID"
    On Error Resume Next
    For i = 0 To GraphicsCount - 1
            Set Gr = Grs(i)
            DD(i + 1, j) = Gr.Type
            DD(i + 1, j + 1) = Gr.Properties("Info")
            DD(i + 1, j + 2) = Gr.Properties("PenColor")
            DD(i + 1, j + 3) = Gr.Properties("PenStyle")
            DD(i + 1, j + 4) = Gr.Properties("Layer")
            DD(i + 1, j + 5) = Gr.ID
            Set Gr = Nothing
       ' j = j + 1
    Next i

    i = 0
    j = 0

    For i = 0 To GraphicsCount - 1
        W.Cells(i + 1, j + 1) = DD(i, j)
        For j = 1 To 5
            W.Cells(i + 1, j + 1) = DD(i, j)
        Next j
        j = 0
    Next i
    W.Columns.AutoFit

End Sub


Examples - %%PROJECT_NAME%%modExExport.bas

modExExport.bas

Attribute VB_Name = "modExExport"
Option Explicit

Public Sub Main()

End Sub


Examples - Excel Filter - Excel.cls

Excel.cls

Excel Filter Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ExExport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2000                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
'local variable(s) to hold property value(s)
Private mvarClassID As String 'local copy
Private mvarDescription As String 'local copy
Private mvarInfo As String 'local copy
Private mvarLastError As String 'local copy
Dim ExApp As Excel.Application
Dim pWbs As Workbooks
Dim pWb As Workbook
Dim pWss As Worksheets
Dim pWs As Worksheet
Private Init1 As Boolean
Dim GraphicsCount As Long
Dim Grs As Graphics
Public Property Get Info() As String
        Info = "MSEExport.ExExport,Microsoft Excel File,0,10,xls,xls"
End Property

Public Function Initialize(ByVal ThisFilter As Object) As Boolean
    Initialize = True
End Function

Public Function WriteSetup(ByVal ThisFilter As Object) As Boolean
    MsgBox "Add your code here !"
End Function

Public Function WriteFlat(ByVal FileName As String, ByVal Aspect As Long, ByVal Graphics As Object, Optional Query As Variant) As Long
On Error GoTo ExcelWontInit
    Set ExApp = CreateObject("Excel.Application")
    Set pWbs = ExApp.Workbooks
    Set pWb = pWbs.Add
    Set pWs = pWb.Worksheets(1) '.Add
    Set Grs = Graphics
    GraphicsCount = Grs.Count

    Call Fill_Sheet(pWs, "Graphic's properties")

    Set Grs = Nothing
    pWb.SaveAs FileName ', , , , , , xlShared
    pWb.Close
    pWbs.Close

    ExApp.Quit

    Set pWs = Nothing
    Set pWb = Nothing
    Set pWbs = Nothing
    Set ExApp = Nothing
    'MsgBox "Success !"
    Exit Function
ExcelWontInit:
    MsgBox "Can't initiaize Excel Application. Probably there is not Excel installed !"
    MsgBox Err.Description
    Err.Clear
    ExApp.Quit

    Set pWs = Nothing
    Set pWb = Nothing
    Set pWbs = Nothing
    Set ExApp = Nothing
End Function
'Public Function ReadSetup(ByVal ThisFilter As Object) As Boolean
'End Function

''Public Function ReadFlat(ByVal FileName As String, ByVal Aspect As Long, ByVal Graphics As Object, Optional Query As Variant) As Long
'    ReadFlat = False
'End Function

Public Function PreviewFlat(ByVal ThisFilter As Object, ByVal FileName As String, ByVal WidthA As Long, ByVal HeightA As Long, Description As String, Thumbnail As Variant) As Long
    PreviewFlat = -1
End Function

Public Function CheckFlat(ByVal ThisFilter As Object, ByVal FileName As String, ByVal Aspect As Long, ByVal Query As Variant) As Long
End Function

Public Property Get LastError() As String
Attribute LastError.VB_Description = "Get"
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.LastError
    LastError = mvarLastError
End Property

' GetInfo:  return the filter's info string
' Our info string is "MSEExport.Excel,Microsoft Excel File,0,10,xls,xls", stored in the DLL's
' resource.

' The info string contains the following fields, delimited by commas:
' Field Name                                Value
' 1.    Filter ID                           "MSEExport.Excel"
' the Filter ID must contains 32 symbols not more'
' otherwise your custom filter will not registered properly by turboCAD
'        Used as the internal name (must be unique).
'        Should be the same as the ProgID registered for the server.
'        TurboCAD reserves names beginning with an asterisk.
' 2.    File type string for common dialog  "Microsoft Excel File";
'        This string appears in Windows dialog file type combo box.
' 3.    Document type handled by filter     0
'        This should always be zero for automation filters.
' 4.    Priority                            10
'        Arbitrary integer value used to determine search order for multiple filters which
'        support the same document type and file extension.
' 5.    Exported function name prefix       "xls"
'        Not used by automation filters, but a non-blank string must be supplied.
' 6-n.  File extensions                     "xls"
'        Used in common dialog and for matching.

Public Property Get Description() As String
Attribute Description.VB_Description = "Get"
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.Description
    Description = mvarDescription
End Property

Public Property Get ClassID() As String
Attribute ClassID.VB_Description = "Get"
'used when retrieving value of a property, on the right side of an assignment.
'Syntax: Debug.Print X.ClassID
    ClassID = mvarClassID
End Property
Private Sub Fill_Sheet(W As Worksheet, SheetName As String)

    Dim DD() As String
    Dim i As Long
    Dim j As Long
    Dim Gr As Graphic
    i = 0
    j = 0

    W.Name = SheetName '"Graphic's properties"

    ReDim DD(GraphicsCount, 5)
    DD(0, 0) = "GraphicType"
    DD(0, 1) = "GraphicInfo"
    DD(0, 2) = "PenColor"
    DD(0, 3) = "PenStyle"
    DD(0, 4) = "Layer"
    DD(0, 5) = "GraphicID"
    On Error Resume Next
    For i = 0 To GraphicsCount - 1
            Set Gr = Grs(i)
            DD(i + 1, j) = Gr.Type
            DD(i + 1, j + 1) = Gr.Properties("Info")
            DD(i + 1, j + 2) = Gr.Properties("PenColor")
            DD(i + 1, j + 3) = Gr.Properties("PenStyle")
            DD(i + 1, j + 4) = Gr.Properties("Layer")
            DD(i + 1, j + 5) = Gr.ID
            Set Gr = Nothing
       ' j = j + 1
    Next i

    i = 0
    j = 0

    For i = 0 To GraphicsCount - 1
        W.Cells(i + 1, j + 1) = DD(i, j)
        For j = 1 To 5
            W.Cells(i + 1, j + 1) = DD(i, j)
        Next j
        j = 0
    Next i
    W.Columns.AutoFit

End Sub


Examples - Excel Filter - modExExport.bas

modExExport.bas

Excel Filter Example

Attribute VB_Name = "modExExport"
Option Explicit

Public Sub Main()

End Sub


Examples - 3D Bolts Regen - clsBolt3D.cls

clsBolt3D.cls

3D Bolts Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Detail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265
Const Eps = 0.0001
'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idDiameter = 1
Const idLength = 2
Const idBType = 3
Const idLengthThread = 4

Const idDiameterOld = 5
Const idLengthOld = 6
Const idBTypeOld = 7
Const idLengthThreadOld = 8

Const idSolid = 9
Const idSolidOld = 10

'Const idx0Old = 9
'Const idy0Old = 10
'Const idx1Old = 11
'Const idy1Old = 12

'Property enums
Const NUM_TYPES = 0

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 10
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private PColor As Long
Private BColor As Long

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "SDK Bolt_Screw3D"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{FDB6F1C3-9631-11d1-A40A-0000B465872B}"

End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)

    Names(0) = "Diameter"
    Types(0) = typeDouble
    IDs(0) = idDiameter
    Defaults(0) = 1#

    Names(1) = "Length"
    Types(1) = typeDouble
    IDs(1) = idLength
    Defaults(1) = 3#

    Names(2) = "BType"
    Types(2) = typeString
    IDs(2) = idBType
    Defaults(2) = "HexBolt"

    Names(3) = "LengthThread"
    Types(3) = typeDouble
    IDs(3) = idLengthThread
    Defaults(3) = 1.5

    Names(4) = "DiameterOld"
    Types(4) = typeDouble
    IDs(4) = idDiameterOld
    Defaults(4) = 1.5

    Names(5) = "LengthOld"
    Types(5) = typeDouble
    IDs(5) = idLengthOld
    Defaults(5) = 3#

    Names(6) = "BTypeOld"
    Types(6) = typeString
    IDs(6) = idBTypeOld
    Defaults(6) = "HexBolt"

    Names(7) = "LengthThreadOld"
    Types(7) = typeDouble
    IDs(7) = idLengthThreadOld
    Defaults(7) = 1.5

    Names(8) = "BoltSolid"
    Types(8) = typeInteger
    IDs(8) = idSolid
    Defaults(8) = 0

    Names(9) = "BoltSolidOld"
    Types(9) = typeInteger
    IDs(9) = idSolidOld
    Defaults(9) = 0

'    Names(8) = "x0Old"
'    Types(8) = typeDouble
'    IDs(8) = idx0Old
'    Defaults(8) = 1#

'    Names(9) = "y0Old"
'    Types(9) = typeDouble
'    IDs(9) = idy0Old
'    Defaults(9) = 1#

'    Names(10) = "x1Old"
'    Types(10) = typeDouble
'    IDs(10) = idx1Old
'    Defaults(10) = 1#

'    Names(11) = "y1Old"
'    Types(11) = typeDouble
'    IDs(11) = idy1Old
'    Defaults(11) = 1#

   GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmBolt3D
    Names(0) = frmBolt3D.Caption
    Unload frmBolt3D

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
        GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed
        Dim Diameter#, Length#, LengthThread#
        Dim SSolid%
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmBolt3D
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next
                'When the property page is closed, transfer the numeric
                'Diameter value from the TextBox to the Graphic
                'Get the value as a double-precision number
                Diameter# = CDbl(.txtdd.Text)
                Length# = CDbl(.txtLen.Text)
                LengthThread# = CDbl(.txtThread.Text)
                TypeB = .List1.Text
  '              SSolid = .Surf_Solid.Value
                 If .Surf_Solid.Value = True Then ' if surface
                    SSolid = False
                 ElseIf .Surf_Solid1.Value = True Then
                    SSolid = True
                 End If

                'Make sure it's between 0 and 100
                If Diameter# < 0# Then Diameter# = 1#
                If LengthThread > Length Then LengthThread = Length
                'Set the roundness property value in the Graphic
                Graphic.Properties("Diameter") = Diameter#
                Graphic.Properties("Length") = Length#
                Graphic.Properties("LengthThread") = LengthThread#
                Graphic.Properties("BType") = TypeB
                Graphic.Properties("BoltSolid") = SSolid
            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
                Diameter# = Graphic.Properties("Diameter")
                Length# = Graphic.Properties("Length")
                LengthThread = Graphic.Properties("LengthThread")
                TypeB = Graphic.Properties("BType")
                SSolid = Graphic.Properties("BoltSolid")
            Load frmBolt3D
            With frmBolt3D

                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                'roundness value from the Graphic to the TextBox
                'Get the roundness property value from the Graphic
                'Set the TextBox control's text
                .txtdd.Text = Diameter#
                .txtLen = Length#
                .txtThread.Text = LengthThread#
'                .Surf_Solid.Value = SSolid
                 If SSolid = True Then
                    .Surf_Solid1.Value = True
                    .Surf_Solid.Value = False
                 ElseIf SSolid = False Then
                    .Surf_Solid1.Value = False
                    .Surf_Solid.Value = True
                 End If

NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmBolt3D
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmBolt3D
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis1 As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If
Dim grfThis As Graphic
    Set grfThis = grfThis1
    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "first point of axis"
    grfThis.Vertices.UseWorldCS = True
    grfThis.Vertices.Add 2#, 5#, 0#, False, True, True, False, False, False

    'Second Vertex is "Second point of axis"
    grfThis.Vertices.Add 6#, 5#, 0#, False, True, True, False, False, False
 '   grfThis.Properties("PenWidth") = 0.04
 '   grfThis.Properties("PenColor") = RGB(255, 0, 0)

    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis1 As Object)
        'Setup error handler
        On Error GoTo Failed
Dim grfThis As Graphic
        Set grfThis = grfThis1
        'Set up lock (prevent recursion)
Dim LockCount&
        LockCount& = grfThis.RegenLock
        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
Dim dd#
            dd = grfThis.Properties("Diameter")
Dim TypeBb
            TypeBb = grfThis.Properties("BType")

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim Salp#, Calp#, L#
Dim X00#, Y00#, Z00#, X01#, Y01#, Z01#
Dim LenProp#
            LenProp = grfThis.Properties("Length")
Dim lThread#
            lThread = grfThis.Properties("LengthThread")
            If lThread > LenProp Then
                lThread = LenProp
                grfThis.Properties("LengthThread") = lThread
            End If
            grfThis.Vertices.UseWorldCS = True
            With grfThis.Vertices
                X00 = .Item(0).X
                Y00 = .Item(0).Y
                Z00 = .Item(0).Z
                X01 = .Item(1).X
                Y01 = .Item(1).Y
                Z01 = .Item(1).Z
                L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00))
                Salp = (Y01 - Y00) / L
                Calp = (X01 - X00) / L
'                .Item(1).X = X00 + LenProp * Calp
'                .Item(1).Y = Y00 + LenProp * Salp
'                X01 = .Item(1).X
'                Y01 = .Item(1).Y
            End With
'            L = LenProp
Dim ddOld#
            ddOld = grfThis.Properties("DiameterOld")
Dim LOld#
            LOld = grfThis.Properties("LengthOld")
Dim LThreadOld#
            LThreadOld = grfThis.Properties("LengthThreadOld")
Dim TypeBOld$
            TypeBOld = grfThis.Properties("BTypeOld")
Dim SSolid%, SolidOld%
            SSolid = grfThis.Properties("BoltSolid")
            SolidOld = grfThis.Properties("BoltSolidOld")

'MsgBox ("L=" & CStr(L) & "  LOld=" & CStr(LOld))
'MsgBox ("dd=" & CStr(dd) & "  ddOld=" & CStr(ddOld))
'MsgBox ("LThread=" & CStr(LThread) & "  LThreadOld=" & CStr(LThreadOld))
'MsgBox (TypeB & "    " & TypeBOld)
Dim CountCosm As Long, iCosm As Long
            CountCosm = grfThis.Graphics.Count
            If CountCosm > 1 Then
                For iCosm = 1 To CountCosm - 1
                    grfThis.Graphics(iCosm).Properties("PenColor") = grfThis.Properties("PenColor")
                Next iCosm
            End If
            If grfThis.Properties("Selected") = False Or SSolid <> SolidOld Or Abs(L - LenProp) > Eps Or Abs(L - LOld) > Eps Or Abs(dd - ddOld) > Eps Or Abs(lThread - LThreadOld) > Eps Or TypeBb <> TypeBOld Then
'MsgBox ("11111")
                L = LenProp
                grfThis.Graphics.Clear gfCosmetic
' Block for Scaling
Dim AddScale#
 '               AddScale = 100# / dd
                AddScale = 1
                dd = dd * AddScale
                L = L * AddScale
                lThread = lThread * AddScale
'                With grfThis.Vertices
'                    .Item(1).X = X00 + L * Calp
'                    .Item(1).Y = Y00 + L * Salp
'                End With

                If TypeBb = "HexBolt" Then Call HexBolt(grfThis, dd, L, Salp, Calp, lThread, SSolid)
                If TypeBb = "SlottedBolt" Then Call SlottedBolt(grfThis, dd, L, Salp, Calp, lThread, SSolid)
                If TypeBb = "HexFlScrew" Then Call HexFlScrew(grfThis, dd, L, Salp, Calp, lThread, SSolid)
' Block for Unscaling
                dd = dd / AddScale
                L = L / AddScale
                lThread = lThread / AddScale
'Dim Matr As Matrix
'                Set Matr = grfThis.Scale(1# / AddScale, 1# / AddScale, 1# / AddScale, X00, Y00, 0)

                grfThis.Properties("DiameterOld") = dd
                grfThis.Properties("LengthOld") = L
                grfThis.Properties("LengthThreadOld") = lThread
                grfThis.Properties("DiameterOld") = dd
                grfThis.Properties("BTypeOld") = TypeBb
                grfThis.Properties("BoltSolidOld") = SSolid
            End If

        End If

        grfThis.RegenUnlock
        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:

'        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
'        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function
Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function

' HexBolt

Private Sub HexBolt(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, lThread As Double, SSolid As Integer)
On Error GoTo Failed
Dim D#, H#, T#, J#, del#, E#, F#
        D = 1.75 * dd
        H = 0.65 * dd
        E = 0.875 * H
        F = D / 4#
        del = 0.1 * dd

Dim Grs As Graphics
    Set Grs = Gr.Drawing.Graphics
Dim X00#, Y00#, Z00#, X01#, Y01#, Z01#
Dim AddScale#, L1#
        AddScale = 1
        Gr.Vertices.UseWorldCS = True
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            Z00 = .Item(0).Z
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            Z01 = .Item(1).Z
            L1 = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00))
'MsgBox ("L=" & CStr(L) & "  H=" & CStr(H) & "  L1=" & CStr(L1))
            If Abs(L + H - L1) > 0.001 Then
                .Item(0).X = X00 - (X01 - X00) * H / AddScale / L1
                .Item(0).Y = Y00 - (Y01 - Y00) * H / AddScale / L1
                .Item(0).Z = Z00 - (Z01 - Z00) * H / AddScale / L1
                .Item(1).X = X00 + (X01 - X00) * L / AddScale / L1
                .Item(1).Y = Y00 + (Y01 - Y00) * L / AddScale / L1
                .Item(1).Z = Z00 + (Z01 - Z00) * L / AddScale / L1
                X01 = X00 + (X01 - X00) * L / L1
                Y01 = Y00 + (Y01 - Y00) * L / L1
                Z01 = Z00 + (Z01 - Z00) * L / L1
            End If
        End With
Dim X00New#, Y00New#, Z00New#, X01New#, Y01New#, Z01New#
        X00New = X00
        Y00New = Y00
        Z00New = Z00
        X01New = X01
        Y01New = Y01
        Z01New = Z01
        X00 = 0
        Y00 = 0
        Z00 = 0
        X01 = L
        Y01 = 0
        Z01 = 0

Dim X0(100)
Dim Y0(100)
'################################################################
'Cylinder
       X0(1) = -0.5 * H
       Y0(1) = 0#

       X0(2) = -0.5 * H
       Y0(2) = dd / 2

       X0(3) = L - del
       Y0(3) = dd / 2#

       X0(4) = 1 * L
       Y0(4) = dd / 2 - del

       X0(5) = 1 * L
       Y0(5) = 0#

       X0(6) = X0(1)
       Y0(6) = Y0(1)
Dim i%
Dim Gr1 As Graphic
Dim GrTemp As Graphic
'Add child Graphics revolve Contour
            Set GrTemp = Grs.Add(gkGraphic)
            With GrTemp.Vertices
                For i = 1 To 6
                    .Add X0(i), Y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
            Set Gr1 = Grs.Add(, "TCW40SPIN")
            Gr1.Properties("Solid") = SSolid
            Gr1.Properties("$ROTATIONANGLE") = 360#
            Gr1.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr1.Graphics.AddGraphic GrTemp
            Gr1.Vertices.Add X0(1), Y0(1), 0, False, False, False, False, False
            Gr1.Vertices.Add X0(5), Y0(5), 0, False, False, False, False, False
'################################################################
' Thread
    'Base contour
Dim hThread# ' Step of the thread
    hThread = del / Sin(Pi / 3)
Dim nCoil As Long, k As Long
    nCoil = 10
    nCoil = CLng(lThread / hThread)

'    X0(7) = 1.01 * L
'    Y0(7) = dd / 2 - 1.1 * del

'    X0(8) = 1.01 * L - hThread / 2
'    Y0(8) = 1# * dd / 2 + 0.1 * del

'    X0(9) = 1.01 * L - hThread / 2
'    Y0(9) = dd / 2 + del

'    X0(10) = 1.01 * L + hThread / 2
'    Y0(10) = dd / 2 + del

'    X0(11) = 1.01 * L + hThread / 2
'    Y0(11) = 1# * dd / 2 + 0.1 * del

'    X0(12) = X0(7)
'    Y0(12) = Y0(7)

Dim lThreadNew#
    lThreadNew = nCoil * hThread
Dim k1 As Long
    X0(1) = L#
    Y0(1) = dd#

    X0(2) = L#
    Y0(2) = dd / 2
    k1 = 2
    For i = 1 To nCoil
        k1 = k1 + 1
        X0(k1) = X0(k1 - 1) - hThread / 2
        Y0(k1) = Y0(k1 - 1) - del
        k1 = k1 + 1
        X0(k1) = X0(k1 - 1) - hThread / 2
        Y0(k1) = Y0(k1 - 1) + del
    Next i

    k1 = k1 + 1
    X0(k1) = L - lThreadNew
    Y0(k1) = dd

    k1 = k1 + 1
    X0(k1) = L
    Y0(k1) = dd
Set GrTemp = Grs.Add(gkGraphic)
With GrTemp.Vertices
    For i = 1 To k1
        .Add X0(i), Y0(i), 0
    Next i
End With
GrTemp.Closed = True
Dim Gr2 As Graphic
Set Gr2 = Grs.Add(, "TCW40SPIN")
Gr2.Properties("Solid") = SSolid
Gr2.Properties("$ROTATIONANGLE") = 360#
'Gr2.Properties("$SPIRENUMBER") = nCoil
'Gr2.Properties("$STEP") = 1.05 * hThread  '1.015
Gr2.Properties("$ROTATIONCOPY") = 30
Set GrTemp = Grs.Remove(GrTemp.Index)
Gr2.Graphics.AddGraphic GrTemp
Gr2.Vertices.Add X01, Y01, 0, False, False, False, False, False
Gr2.Vertices.Add X00, Y00, 0, False, False, False, False, False
'###############################################################
' Head of the bolt
    For i = 7 To 13
        X0(i) = D / 2 * Cos(Pi / 3 * (i - 7))
        Y0(i) = D / 2 * Sin(Pi / 3 * (i - 7))
    Next i
Dim Gr3 As Graphic
Set Gr3 = Grs.Add(gkGraphic)
With Gr3.Vertices
    For i = 7 To 13
        .Add X0(i), Y0(i), 0, True, True, False, False, False, False
    Next i
End With
Gr3.Closed = True
Gr3.Properties("Thickness") = H
Gr3.Properties("Solid") = SSolid
Dim xTo#, yTo#, zTo#, xFrom#, yFrom#, zFrom#, xRef#, yRef#, zRef#
    xTo = X00 + (X01 - X00) / L
    yTo = Y00 + (Y01 - Y00) / L
    zTo = 0
    xFrom = X00
    yFrom = Y00
    zFrom = 1#
    xRef = X00
    yRef = Y00
    zRef = 0#
    Gr3.RotateAbsolute xTo, yTo, zTo, xFrom, yFrom, zFrom, xRef, yRef, zRef
'##################################################################
 'faska on head
    T = D / 2 * Sin(Pi / 3)
       X0(1) = -1.1 * H
       Y0(1) = T * 0.7 - 0.1 * H / Tan(Pi / 6)

       X0(2) = -1.1 * H
       Y0(2) = D

       X0(3) = -H + 0.4 * H
       Y0(3) = D

       X0(4) = -H + 0.4 * H
       Y0(4) = T * 0.7 + 0.5 * H / Tan(Pi / 6)

       X0(5) = X0(1)
       Y0(5) = Y0(1)

'-----------------------------------------------------------

            Set GrTemp = Grs.Add(gkGraphic)
            With GrTemp.Vertices
                For i = 1 To 5
                    .Add X0(i), Y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
Dim Gr4 As Graphic
            Set Gr4 = Grs.Add(, "TCW40SPIN")
            Gr4.Properties("Solid") = SSolid
            Gr4.Properties("$ROTATIONANGLE") = 360#
            Gr4.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr4.Graphics.AddGraphic GrTemp
            Gr4.Vertices.Add X00, Y00, 0, False, False, False, False, False
            Gr4.Vertices.Add X01, Y01, 0, False, False, False, False, False
'#################################################################
' Boolean operations
Dim Bool3D As Boolean3D
    Set Bool3D = New Boolean3D
Dim Res As Long
Dim GrIndex As Long

Dim GrRes1 As Graphic
    Res = 1
    Gr1.Update
    Gr2.Update
    Set GrRes1 = Bool3D.Subtract(Gr1, Gr2, Res)
    If Res = 0 Then
        Gr1.Deleted = True
        Gr2.Deleted = True
        Grs.AddGraphic GrRes1
    End If

 Dim GrRes2 As Graphic
    Res = 1
    GrRes1.Update
    Gr3.Update
    Set GrRes2 = Bool3D.Add(GrRes1, Gr3, Res)
    If Res = 0 Then
        GrRes1.Deleted = True
        Gr3.Deleted = True
        Grs.AddGraphic GrRes2
    End If

 Dim GrRes3 As Graphic
    Res = 1
    GrRes2.Update
    Gr4.Update
    Set GrRes3 = Bool3D.Subtract(GrRes2, Gr4, Res)
    If Res = 0 Then
        GrRes2.Deleted = True
        Gr4.Deleted = True
        Grs.AddGraphic GrRes3
    End If

    GrIndex = GrRes3.Index
    Grs.Remove GrIndex
    Gr.Graphics.AddGraphic GrRes3
    GrRes3.Cosmetic = True
    GrRes3.Properties("PenColor") = Gr.Properties("PenColor")
'?????????????????????????????????????????????????????????????
Dim GrLine As Graphic
    Set GrLine = Grs.Add(11)
    GrLine.Vertices.UseWorldCS = True
    With GrLine.Vertices
        .Add -H, 0, 0
        .Add L, 0, 0
    End With
    GrLine.Properties("PenColor") = RGB(255, 0, 0)
    GrIndex = GrLine.Index
    Grs.Remove GrIndex
    Gr.Graphics.AddGraphic GrLine
    GrLine.Cosmetic = True
Dim xx0#, yy0#, zz0#, xx1#, yy1#, zz1#
'    GrRes3.MoveRelative X00New, Y00New, Z00New
'    GrLine.MoveRelative X00New, Y00New, Z00New

    GrLine.Vertices.UseWorldCS = False
    With GrLine.Vertices
        xx0 = .Item(0).X
        yy0 = .Item(0).Y
        zz0 = .Item(0).Z
        xx1 = .Item(1).X
        yy1 = .Item(1).Y
        zz1 = .Item(1).Z
    End With
    Gr.Vertices.UseWorldCS = False
    With Gr.Vertices
        X00New = .Item(0).X
        Y00New = .Item(0).Y
        Z00New = .Item(0).Z
   End With
'    GrLine.MoveRelative X00New - xx0, Y00New - yy0, Z00New - zz0
    GrRes3.MoveRelative X00New - xx0, Y00New - yy0, Z00New - zz0
    GrLine.Deleted = True
'?????????????????????????????????????????????????????????????

    Set Gr1 = Nothing
    Set Gr2 = Nothing
    Set Gr3 = Nothing
    Set Gr4 = Nothing
    Set GrRes1 = Nothing
    Set GrRes2 = Nothing
    Set GrRes3 = Nothing
    Set GrTemp = Nothing
    Set Grs = Nothing
    Set Bool3D = Nothing

Exit Sub
Failed:

        If Err.Number <> 0 Then
            MsgBox "Regen error: " & Err.Description
        End If
End Sub

' Slotted Bolt

Private Sub SlottedBolt(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, lThread As Double, SSolid As Integer)
On Error GoTo Failed
Dim D#, H#, T#, J#, del#, E#, F#
        D = 1.875 * dd
        H = 0.494 * dd
        T = 0.24 * dd
        J = 0.19 * dd
        del = 0.1 * dd

Dim Grs As Graphics
    Set Grs = Gr.Drawing.Graphics
Dim X00#, Y00#, Z00#, X01#, Y01#, Z01#
Dim AddScale#, L1#
        AddScale = 1
        Gr.Vertices.UseWorldCS = True
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            Z00 = .Item(0).Z
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            Z01 = .Item(1).Z
            L1 = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00))
            .Item(1).X = X00 + (X01 - X00) * L / AddScale / L1
            .Item(1).Y = Y00 + (Y01 - Y00) * L / AddScale / L1
            .Item(1).Z = Z00 + (Z01 - Z00) * L / AddScale / L1
            X01 = X00 + (X01 - X00) * L / L1
            Y01 = Y00 + (Y01 - Y00) * L / L1
            Z01 = Z00 + (Z01 - Z00) * L / L1
        End With
Dim X00New#, Y00New#, Z00New#, X01New#, Y01New#, Z01New#
        X00New = X00
        Y00New = Y00
        Z00New = Z00
        X01New = X01
        Y01New = Y01
        Z01New = Z01
        X00 = 0
        Y00 = 0
        Z00 = 0
        X01 = L
        Y01 = 0
        Z01 = 0

Dim X0(100)
Dim Y0(100)

       X0(1) = 0.9 * H
       Y0(1) = 0#

       X0(2) = 0.9 * H
       Y0(2) = dd / 2

       X0(3) = L - del
       Y0(3) = dd / 2#

       X0(4) = 1 * L
       Y0(4) = dd / 2 - del

       X0(5) = 1 * L
       Y0(5) = 0#

       X0(6) = X0(1)
       Y0(6) = Y0(1)
'-----------------------------------------------------------

Dim i%

Dim Gr1 As Graphic
Dim GrTemp As Graphic
'Add child Graphics revolve Contour
            Set GrTemp = Grs.Add(gkGraphic)
            With GrTemp.Vertices
                For i = 1 To 6
                    .Add X0(i), Y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
            Set Gr1 = Grs.Add(, "TCW40SPIN")
            Gr1.Properties("Solid") = SSolid
            Gr1.Properties("$ROTATIONANGLE") = 360#
            Gr1.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr1.Graphics.AddGraphic GrTemp
            Gr1.Vertices.Add X0(1), Y0(1), 0, False, False, False, False, False
            Gr1.Vertices.Add X0(5), Y0(5), 0, False, False, False, False, False

' Thread
    'Base contour
Dim hThread# ' Step of the thread
    hThread = del / Sin(Pi / 3)
Dim nCoil As Long, k As Long
    nCoil = 10
    nCoil = CLng(lThread / hThread)

'    X0(7) = 1.01 * L
'    Y0(7) = dd / 2 - 1.1 * del

'    X0(8) = 1.01 * L - hThread / 2
'    Y0(8) = 1# * dd / 2 + 0.1 * del

'    X0(9) = 1.01 * L - hThread / 2
'    Y0(9) = dd / 2 + del

'    X0(10) = 1.01 * L + hThread / 2
'    Y0(10) = dd / 2 + del

'    X0(11) = 1.01 * L + hThread / 2
'    Y0(11) = 1# * dd / 2 + 0.1 * del

'    X0(12) = X0(7)
'    Y0(12) = Y0(7)

Dim lThreadNew#
    lThreadNew = nCoil * hThread
Dim k1 As Long

    X0(1) = L#
    Y0(1) = dd#

    X0(2) = L#
    Y0(2) = dd / 2

    k1 = 2

    For i = 1 To nCoil
        k1 = k1 + 1
        X0(k1) = X0(k1 - 1) - hThread / 2
        Y0(k1) = Y0(k1 - 1) - del
        k1 = k1 + 1
        X0(k1) = X0(k1 - 1) - hThread / 2
        Y0(k1) = Y0(k1 - 1) + del
    Next i
    k1 = k1 + 1
    X0(k1) = L - lThreadNew
    Y0(k1) = dd

    k1 = k1 + 1
    X0(k1) = L
    Y0(k1) = dd

    Set GrTemp = Grs.Add(gkGraphic)
    With GrTemp.Vertices
'    For i = 7 To 12
        For i = 1 To k1
            .Add X0(i), Y0(i), 0
        Next i
    End With
    GrTemp.Closed = True

Dim Gr2 As Graphic
    Set Gr2 = Grs.Add(, "TCW40SPIN")
    Gr2.Properties("Solid") = SSolid
    Gr2.Properties("$ROTATIONANGLE") = 360#
    'Gr2.Properties("$SPIRENUMBER") = nCoil
    'Gr2.Properties("$STEP") = 1.05 * hThread  '1.015
    Gr2.Properties("$ROTATIONCOPY") = 30
    Set GrTemp = Grs.Remove(GrTemp.Index)
    Gr2.Graphics.AddGraphic GrTemp
    Gr2.Vertices.Add X01, Y01, 0, False, False, False, False, False
    Gr2.Vertices.Add X00, Y00, 0, False, False, False, False, False

'############################################################
'############################################################
' Head of the bolt

       X0(1) = 0#
       Y0(1) = 0#

       X0(2) = 0#
       Y0(2) = D / 2#

       X0(3) = H
       Y0(3) = dd / 2#

       X0(4) = H
       Y0(4) = 0#

       X0(5) = X0(1)
       Y0(5) = Y0(1)

        Set GrTemp = Grs.Add(gkGraphic)

        With GrTemp.Vertices
            For i = 1 To 5
                .Add X0(i), Y0(i), 0
            Next i
        End With
        GrTemp.Closed = True
Dim Gr3 As Graphic
        Set Gr3 = Grs.Add(, "TCW40SPIN")
        Gr3.Properties("Solid") = SSolid
        Gr3.Properties("$ROTATIONANGLE") = 360#
        Gr3.Properties("$ROTATIONCOPY") = 30
        Set GrTemp = Grs.Remove(GrTemp.Index)
        Gr3.Graphics.AddGraphic GrTemp
        Gr3.Vertices.Add X0(1), Y0(1), 0, False, False, False, False, False
        Gr3.Vertices.Add X0(4), Y0(4), 0, False, False, False, False, False

'################################################################
'################################################################

       X0(1) = -0.1 * H
       Y0(1) = 1.1 * D / 2

       X0(2) = T
       Y0(2) = 1.1 * D / 2

       X0(3) = T
       Y0(3) = -1.1 * D / 2

       X0(4) = -0.1 * H
       Y0(4) = -1.1 * D / 2

       X0(5) = X0(1)
       Y0(5) = Y0(1)

'-----------------------------------------------------------
Dim Gr4 As Graphic
            Set Gr4 = Grs.Add(gkGraphic)
            With Gr4.Vertices
                For i = 1 To 5
                    .Add X0(i), Y0(i), 0
                Next i
            End With
            Gr4.Closed = True
            Gr4.Properties("Thickness") = J
            Gr4.Properties("Solid") = SSolid
            Gr4.MoveRelative 0#, 0#, -J / 2
'#################################################################
'################################################################
' Boolean operations
Dim Bool3D As Boolean3D
    Set Bool3D = New Boolean3D
Dim Res As Long
Dim GrIndex As Long

Dim GrRes1 As Graphic
    Res = 1
    Gr1.Update
    Gr2.Update
    Set GrRes1 = Bool3D.Subtract(Gr1, Gr2, Res)
    If Res = 0 Then
        Gr1.Deleted = True
        Gr2.Deleted = True
        Grs.AddGraphic GrRes1
    End If

 Dim GrRes2 As Graphic
    Res = 1
    GrRes1.Update
    Gr3.Update
    Set GrRes2 = Bool3D.Add(GrRes1, Gr3, Res)
    If Res = 0 Then
        GrRes1.Deleted = True
        Gr3.Deleted = True
        Grs.AddGraphic GrRes2
    End If

 Dim GrRes3 As Graphic
    Res = 1
    GrRes2.Update
    Gr4.Update
    Set GrRes3 = Bool3D.Subtract(GrRes2, Gr4, Res)
    If Res = 0 Then
        GrRes2.Deleted = True
        Gr4.Deleted = True
        Grs.AddGraphic GrRes3
    End If

    GrIndex = GrRes3.Index
    Grs.Remove GrIndex
    Gr.Graphics.AddGraphic GrRes3
    GrRes3.Cosmetic = True
    GrRes3.Properties("PenColor") = Gr.Properties("PenColor")
'?????????????????????????????????????????????????????????????
Dim GrLine As Graphic
    Set GrLine = Grs.Add(11)
    GrLine.Vertices.UseWorldCS = True
    With GrLine.Vertices
        .Add 0, 0, 0
        .Add L, 0, 0
    End With
    GrLine.Properties("PenColor") = RGB(255, 0, 0)
    GrIndex = GrLine.Index
    Grs.Remove GrIndex
    Gr.Graphics.AddGraphic GrLine
    GrLine.Cosmetic = True
Dim xx0#, yy0#, zz0#, xx1#, yy1#, zz1#
    GrLine.Vertices.UseWorldCS = False
    With GrLine.Vertices
        xx0 = .Item(0).X
        yy0 = .Item(0).Y
        zz0 = .Item(0).Z
        xx1 = .Item(1).X
        yy1 = .Item(1).Y
        zz1 = .Item(1).Z
    End With
    Gr.Vertices.UseWorldCS = False
    With Gr.Vertices
        X00New = .Item(0).X
        Y00New = .Item(0).Y
        Z00New = .Item(0).Z
    End With
    GrRes3.MoveRelative X00New - xx0, Y00New - yy0, Z00New - zz0
    GrLine.Deleted = True
'?????????????????????????????????????????????????????????????

    Set Gr1 = Nothing
    Set Gr2 = Nothing
    Set Gr3 = Nothing
    Set Gr4 = Nothing
    Set GrRes1 = Nothing
    Set GrRes2 = Nothing
    Set GrRes3 = Nothing
    Set GrTemp = Nothing
    Set Grs = Nothing
    Set Bool3D = Nothing

Exit Sub
Failed:

        If Err.Number <> 0 Then
            MsgBox "Regen error: " & Err.Description
        End If
End Sub

' HexFlange Screw

Private Sub HexFlScrew(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, lThread As Double, SSolid As Integer)
On Error GoTo Failed
Dim D#, Dw#, Di#, C#, k1#, k#, E#, del#
        D = 1.4 * dd
        Dw = 2.08 * dd
        C = 0.15 * dd
        k1 = 0.43 * dd
        k = 0.97 * dd
        E = (k - k1) * 0.85
        Di = D * Sin(Pi / 3)
        del = 0.1 * dd

Dim Grs As Graphics
    Set Grs = Gr.Drawing.Graphics
Dim X00#, Y00#, Z00#, X01#, Y01#, Z01#
Dim AddScale#, L1#
        AddScale = 1
        Gr.Vertices.UseWorldCS = True
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            Z00 = .Item(0).Z
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            Z01 = .Item(1).Z
            L1 = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00))
            If Abs(L + k - L1) > 0.001 Then
                .Item(0).X = X00 - (X01 - X00) * k / AddScale / L1
                .Item(0).Y = Y00 - (Y01 - Y00) * k / AddScale / L1
                .Item(0).Z = Z00 - (Z01 - Z00) * k / AddScale / L1
                .Item(1).X = X00 + (X01 - X00) * L / AddScale / L1
                .Item(1).Y = Y00 + (Y01 - Y00) * L / AddScale / L1
                .Item(1).Z = Z00 + (Z01 - Z00) * L / AddScale / L1
                X01 = X00 + (X01 - X00) * L / L1
                Y01 = Y00 + (Y01 - Y00) * L / L1
                Z01 = Z00 + (Z01 - Z00) * L / L1
            End If
        End With
Dim X00New#, Y00New#, Z00New#, X01New#, Y01New#, Z01New#
        X00New = X00
        Y00New = Y00
        Z00New = Z00
        X01New = X01
        Y01New = Y01
        Z01New = Z01
        X00 = 0
        Y00 = 0
        Z00 = 0
        X01 = L
        Y01 = 0
        Z01 = 0

Dim X0(100)
Dim Y0(100)
       X0(1) = -0.5 * k
       Y0(1) = 0#

       X0(2) = -0.5 * k
       Y0(2) = dd / 2

       X0(3) = L - del
       Y0(3) = dd / 2#

       X0(4) = 1 * L
       Y0(4) = dd / 2 - del

       X0(5) = 1 * L
       Y0(5) = 0#

       X0(6) = X0(1)
       Y0(6) = Y0(1)
'-----------------------------------------------------------
Dim i%

Dim Gr1 As Graphic
Dim GrTemp As Graphic
'Add child Graphics revolve Contour

            Set GrTemp = Grs.Add(gkGraphic)

            With GrTemp.Vertices
                For i = 1 To 6
                    .Add X0(i), Y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
            Set Gr1 = Grs.Add(, "TCW40SPIN")
            Gr1.Properties("Solid") = SSolid
            Gr1.Properties("$ROTATIONANGLE") = 360#
            Gr1.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr1.Graphics.AddGraphic GrTemp
            Gr1.Vertices.Add X0(1), Y0(1), 0, False, False, False, False, False
            Gr1.Vertices.Add X0(5), Y0(5), 0, False, False, False, False, False
'            GrChild.Properties("$APPROCSIMCURVE") = 36

' Thread
    'Base contour
Dim hThread# ' Step of the thread
    hThread = del / Sin(Pi / 3)
Dim nCoil As Long ', K As Long
    nCoil = 10
    nCoil = CLng(lThread / hThread)

'    X0(7) = 1.01 * L
'    Y0(7) = dd / 2 - 1.1 * del

'    X0(8) = 1.01 * L - hThread / 2
'    Y0(8) = 1# * dd / 2 + 0.1 * del

'    X0(9) = 1.01 * L - hThread / 2
'    Y0(9) = dd / 2 + del

'    X0(10) = 1.01 * L + hThread / 2
'    Y0(10) = dd / 2 + del

'    X0(11) = 1.01 * L + hThread / 2
'    Y0(11) = 1# * dd / 2 + 0.1 * del

'    X0(12) = X0(7)
'    Y0(12) = Y0(7)

Dim lThreadNew#
    lThreadNew = nCoil * hThread
Dim k2 As Long

    X0(1) = L#
    Y0(1) = dd#

    X0(2) = L#
    Y0(2) = dd / 2

    k2 = 2

    For i = 1 To nCoil
        k2 = k2 + 1
        X0(k2) = X0(k2 - 1) - hThread / 2
        Y0(k2) = Y0(k2 - 1) - del
        k2 = k2 + 1
        X0(k2) = X0(k2 - 1) - hThread / 2
        Y0(k2) = Y0(k2 - 1) + del
    Next i
    k2 = k2 + 1
    X0(k2) = L - lThreadNew
    Y0(k2) = dd

    k2 = k2 + 1
    X0(k2) = L
    Y0(k2) = dd

    Set GrTemp = Grs.Add(gkGraphic)
    With GrTemp.Vertices
'    For i = 7 To 12
        For i = 1 To k2
            .Add X0(i), Y0(i), 0
        Next i
    End With
    GrTemp.Closed = True

Dim Gr2 As Graphic
    Set Gr2 = Grs.Add(, "TCW40SPIN")
    Gr2.Properties("Solid") = SSolid
    Gr2.Properties("$ROTATIONANGLE") = 360#
'Gr2.Properties("$SPIRENUMBER") = nCoil
'Gr2.Properties("$STEP") = 1.05 * hThread  '1.015
    Gr2.Properties("$ROTATIONCOPY") = 30
    Set GrTemp = Grs.Remove(GrTemp.Index)
    Gr2.Graphics.AddGraphic GrTemp
    Gr2.Vertices.Add X01, Y01, 0, False, False, False, False, False
    Gr2.Vertices.Add X00, Y00, 0, False, False, False, False, False

' Head of the bolt
    For i = 7 To 13
        X0(i) = D / 2 * Cos(Pi / 3 * (i - 7))
        Y0(i) = D / 2 * Sin(Pi / 3 * (i - 7))
    Next i
Dim Gr3 As Graphic
    Set Gr3 = Grs.Add(gkGraphic)
    With Gr3.Vertices
        For i = 7 To 13
            .Add X0(i), Y0(i), 0, True, True, False, False, False, False
        Next i
    End With
    Gr3.Closed = True
    Gr3.Properties("Thickness") = k
    Gr3.Properties("Solid") = SSolid
Dim xTo#, yTo#, zTo#, xFrom#, yFrom#, zFrom#, xRef#, yRef#, zRef#
    xTo = X00 + (X01 - X00) / L
    yTo = Y00 + (Y01 - Y00) / L
    zTo = 0
    xFrom = X00
    yFrom = Y00
    zFrom = 1#
    xRef = X00
    yRef = Y00
    zRef = 0#
    Gr3.RotateAbsolute xTo, yTo, zTo, xFrom, yFrom, zFrom, xRef, yRef, zRef
'################################################################
'################################################################
Dim T#
    T = D / 2 * Sin(Pi / 3)
       X0(1) = -1.1 * k
       Y0(1) = T * 0.7 - 0.1 * k / Tan(Pi / 6)

       X0(2) = -1.1 * k
       Y0(2) = D

       X0(3) = -k + 0.4 * k
       Y0(3) = D

       X0(4) = -k + 0.4 * k
       Y0(4) = T * 0.7 + 0.5 * k / Tan(Pi / 6)

       X0(5) = X0(1)
       Y0(5) = Y0(1)

'-----------------------------------------------------------

            Set GrTemp = Grs.Add(gkGraphic)
            With GrTemp.Vertices
                For i = 1 To 5
                    .Add X0(i), Y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
Dim Gr4 As Graphic
            Set Gr4 = Grs.Add(, "TCW40SPIN")
            Gr4.Properties("Solid") = SSolid
            Gr4.Properties("$ROTATIONANGLE") = 360#
            Gr4.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr4.Graphics.AddGraphic GrTemp
            Gr4.Vertices.Add X00, Y00, 0, False, False, False, False, False
            Gr4.Vertices.Add X01, Y01, 0, False, False, False, False, False
'#################################################################

'  Begin Flange *******************************************
       X0(1) = -k1
       Y0(1) = 0#

       X0(2) = -k1
       Y0(2) = D / 2

       X0(3) = -C
       Y0(3) = Dw / 2

       X0(4) = 0.01 * k1#
       Y0(4) = Dw / 2

       X0(5) = 0.01 * k1
       Y0(5) = 0#

       X0(6) = X0(1)
       Y0(6) = Y0(1)

'-----------------------------------------------------------
            Set GrTemp = Grs.Add(gkGraphic)
            With GrTemp.Vertices
                For i = 1 To 6
                    .Add X0(i), Y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
Dim Gr5 As Graphic
            Set Gr5 = Grs.Add(, "TCW40SPIN")
            Gr5.Properties("Solid") = SSolid
            Gr5.Properties("$ROTATIONANGLE") = 360#
            Gr5.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr5.Graphics.AddGraphic GrTemp
            Gr5.Vertices.Add X0(1), Y0(1), 0, False, False, False, False, False
            Gr5.Vertices.Add X0(5), Y0(5), 0, False, False, False, False, False
'  End Flange ***********************************************
' Boolean operations
Dim Bool3D As Boolean3D
    Set Bool3D = New Boolean3D
Dim Res As Long
Dim GrIndex As Long

Dim GrRes1 As Graphic
    Res = 1
    Gr1.Update
    Gr2.Update
    Set GrRes1 = Bool3D.Subtract(Gr1, Gr2, Res)
    If Res = 0 Then
        Gr1.Deleted = True
        Gr2.Deleted = True
        Grs.AddGraphic GrRes1
    End If

 Dim GrRes2 As Graphic
    Res = 1
    GrRes1.Update
    Gr3.Update
    Set GrRes2 = Bool3D.Add(GrRes1, Gr3, Res)
    If Res = 0 Then
        GrRes1.Deleted = True
        Gr3.Deleted = True
        Grs.AddGraphic GrRes2
    End If

 Dim GrRes3 As Graphic
    Res = 1
    GrRes2.Update
    Gr4.Update
    Set GrRes3 = Bool3D.Subtract(GrRes2, Gr4, Res)
    If Res = 0 Then
        GrRes2.Deleted = True
        Gr4.Deleted = True
        Grs.AddGraphic GrRes3
    End If

 Dim GrRes4 As Graphic
    Res = 1
    GrRes3.Update
    Gr5.Update
    Set GrRes4 = Bool3D.Add(GrRes3, Gr5, Res)
    If Res = 0 Then
        GrRes3.Deleted = True
        Gr5.Deleted = True
        Grs.AddGraphic GrRes4
    End If

    GrIndex = GrRes4.Index
    Grs.Remove GrIndex
    Gr.Graphics.AddGraphic GrRes4
    GrRes4.Cosmetic = True
    GrRes4.Properties("PenColor") = Gr.Properties("PenColor")
'?????????????????????????????????????????????????????????????
Dim GrLine As Graphic
    Set GrLine = Grs.Add(11)
    GrLine.Vertices.UseWorldCS = True
    With GrLine.Vertices
        .Add -k, 0, 0
        .Add L, 0, 0
    End With
    GrLine.Properties("PenColor") = RGB(255, 0, 0)
    GrIndex = GrLine.Index
    Grs.Remove GrIndex
    Gr.Graphics.AddGraphic GrLine
    GrLine.Cosmetic = True
Dim xx0#, yy0#, zz0#, xx1#, yy1#, zz1#

    GrLine.Vertices.UseWorldCS = False
    With GrLine.Vertices
        xx0 = .Item(0).X
        yy0 = .Item(0).Y
        zz0 = .Item(0).Z
        xx1 = .Item(1).X
        yy1 = .Item(1).Y
        zz1 = .Item(1).Z
    End With
    Gr.Vertices.UseWorldCS = False
    With Gr.Vertices
        X00New = .Item(0).X
        Y00New = .Item(0).Y
        Z00New = .Item(0).Z
    End With
'    GrLine.MoveRelative X00New - xx0, Y00New - yy0, Z00New - zz0
    GrRes4.MoveRelative X00New - xx0, Y00New - yy0, Z00New - zz0
    GrLine.Deleted = True
'?????????????????????????????????????????????????????????????

    Set Gr1 = Nothing
    Set Gr2 = Nothing
    Set Gr3 = Nothing
    Set Gr4 = Nothing
    Set Gr5 = Nothing
    Set GrRes1 = Nothing
    Set GrRes2 = Nothing
    Set GrRes3 = Nothing
    Set GrRes4 = Nothing
    Set GrTemp = Nothing
    Set Grs = Nothing
    Set Bool3D = Nothing

Exit Sub
Failed:

        If Err.Number <> 0 Then
            MsgBox "Regen error: " & Err.Description
        End If
End Sub


Examples - 3D Bolts Regen - frmBolt3D.frm

frmBolt3D.frm

3D Bolts Regen Example

VERSION 5.00
Begin VB.Form frmBolt3D
   BorderStyle     =   1  'Fixed Single
   Caption         =   "3D Bolts and Screws"
   ClientHeight    =   3825
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6330
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3825
   ScaleWidth      =   6330
   StartUpPosition =   1  'CenterOwner
   Begin VB.OptionButton Surf_Solid
      Caption         =   "Surface"
      Height          =   255
      Left            =   3000
      TabIndex        =   11
      Top             =   2400
      Width           =   975
   End
   Begin VB.OptionButton Surf_Solid1
      Caption         =   "Solid"
      Height          =   255
      Left            =   3000
      TabIndex        =   10
      Top             =   2760
      Value           =   -1  'True
      Width           =   855
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   2880
      TabIndex        =   9
      Top             =   3270
      Width           =   1335
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   4800
      TabIndex        =   8
      Top             =   3270
      Width           =   1335
   End
   Begin VB.TextBox txtThread
      Height          =   288
      Left            =   1800
      TabIndex        =   7
      Top             =   3000
      Width           =   735
   End
   Begin VB.ListBox List1
      Height          =   1620
      ItemData        =   "frmBolt3D.frx":0000
      Left            =   120
      List            =   "frmBolt3D.frx":000D
      TabIndex        =   2
      Top             =   450
      Width           =   2415
   End
   Begin VB.TextBox txtdd
      Height          =   285
      Left            =   1800
      TabIndex        =   1
      Top             =   2280
      Width           =   735
   End
   Begin VB.TextBox txtLen
      Height          =   285
      Left            =   1800
      TabIndex        =   0
      Top             =   2640
      Width           =   735
   End
   Begin VB.Frame Frame1
      Caption         =   "3D"
      Height          =   975
      Left            =   2880
      TabIndex        =   12
      Top             =   2160
      Width           =   1335
   End
   Begin VB.Label Label6
      Alignment       =   1  'Right Justify
      Caption         =   "Length of thread (Lt) :"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   3000
      Width           =   1575
   End
   Begin VB.Label Label7
      Alignment       =   1  'Right Justify
      Caption         =   "Length (L) :"
      Height          =   255
      Left            =   720
      TabIndex        =   5
      Top             =   2640
      Width           =   975
   End
   Begin VB.Label Label8
      Alignment       =   1  'Right Justify
      Caption         =   "Diameter (d) :"
      Height          =   255
      Left            =   720
      TabIndex        =   4
      Top             =   2280
      Width           =   975
   End
   Begin VB.Image PicPreview
      BorderStyle     =   1  'Fixed Single
      Height          =   1950
      Left            =   2880
      Stretch         =   -1  'True
      Top             =   120
      Width           =   3300
   End
   Begin VB.Label Label4
      Caption         =   "Bolt Type :"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   120
      Width           =   975
   End
End
Attribute VB_Name = "frmBolt3D"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    TypeB = List1.Text
    Me.Hide
End Sub

Private Sub Form_Load()
Dim i%, iDef%
    For i = 0 To List1.ListCount - 1
        If List1.List(i) = TypeB Then iDef = i
    Next i
    List1.ListIndex = iDef
'    HexBolt.Visible = False
'    SlottedBolt.Visible = False
'    HexFlScrew.Visible = False

'    If List1.Text = "HexBolt" Then HexBolt.Visible = True
'    If List1.Text = "SlottedBolt" Then SlottedBolt.Visible = True
'    If List1.Text = "HexFlScrew" Then HexFlScrew.Visible = True
    If List1.Text = "HexBolt" Then PicPreview.Picture = LoadResPicture(101, 0)
    If List1.Text = "SlottedBolt" Then PicPreview.Picture = LoadResPicture(102, 0)
    If List1.Text = "HexFlScrew" Then PicPreview.Picture = LoadResPicture(103, 0)

End Sub

Private Sub List1_Click()
'    HexBolt.Visible = False
'    SlottedBolt.Visible = False
'    HexFlScrew.Visible = False
'    If List1.Text = "HexBolt" Then HexBolt.Visible = True
'    If List1.Text = "SlottedBolt" Then SlottedBolt.Visible = True
'    If List1.Text = "HexFlScrew" Then HexFlScrew.Visible = True
    If List1.Text = "HexBolt" Then PicPreview.Picture = LoadResPicture(101, 0)
    If List1.Text = "SlottedBolt" Then PicPreview.Picture = LoadResPicture(102, 0)
    If List1.Text = "HexFlScrew" Then PicPreview.Picture = LoadResPicture(103, 0)

End Sub

Private Sub Surf_Solid_Click()
    Surf_Solid1.Value = False
End Sub

Private Sub Surf_Solid1_Click()
    Surf_Solid.Value = False
End Sub


Examples - 3D Bolts Regen - modBolt3D.bas

modBolt3D.bas

3D Bolts Regen Example

Attribute VB_Name = "modBolt3D"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
Global Const Pi = 3.14159
Global TypeB As String
' DLL Entry point
Sub Main()

End Sub


Examples - Bolts and Nuts Regen - clsBoltNut.cls

clsBoltNut.cls

Bolts and Nuts Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Detail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2000                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idBoltType = 1
Const idNutType = 2
Const idNumDiam = 3

'Property enums
Const NUM_TYPEBOLT = 2
Const Bolt1 = 0
Const Bolt2 = 1
Const NUM_TYPENUT = 2
Const Nut1 = 0
Const Nut2 = 1

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 3
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "BoltNut"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{FDB6F1C1-9631-11d1-A40A-0000B465872B}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
    Names(0) = "BoltType"
    Types(0) = typeLong
    IDs(0) = idBoltType
    Defaults(0) = Bolt1

    Names(1) = "NutType"
    Types(1) = typeLong
    IDs(1) = idNutType
    Defaults(1) = Nut1

    Names(2) = "Diameter"
    Types(2) = typeInteger
    IDs(2) = idNumDiam
    Defaults(2) = 8

    GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmBoltNut
    Names(0) = frmBoltNut.Caption
    Unload frmBoltNut

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long

    If PropID = idBoltType Or PropID = idNutType Then
        ReDim Names(NUM_TYPEBOLT), Value(NUM_TYPEBOLT)
        Names(0) = "Bolt1"
        Values(0) = Bolt1

        Names(1) = "Bolt2"
        Values(1) = Bolt2
        GetEnumNames = NUM_TYPEBOLT
        Exit Function
    End If
    If PropID = idNutType Then
        ReDim Names(NUM_TYPENUT), Value(NUM_TYPENUT)
        Names(0) = "Nut1"
        Values(0) = Nut1

        Names(1) = "Nut2"
        Values(1) = Nut2
        GetEnumNames = NUM_TYPENUT
        Exit Function
    End If

        GetEnumNames = 0

End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed
        Dim i%, j%
        Dim Diameter#
        Dim iDiam%
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmBoltNut
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next
                For i = 0 To NUM_TYPEBOLT
                    If .BoltType(i).Value Then
                        Graphic.Properties("BoltType") = i
                        Exit For
                    End If
                Next i
                For j = 0 To NUM_TYPENUT
                    If .NutType(j).Value Then
                        Graphic.Properties("NutType") = j
                        Exit For
                    End If
                Next j
                iDiam = .ListDiam.ListIndex
                Graphic.Properties("Diameter") = iDiam
                'When the property page is closed, transfer the numeric
                'Diameter value from the TextBox to the Graphic
                'Get the value as a double-precision number

'                Diameter# = CDbl(frmBoltNut.ListDiam.Text)

                'Make sure it's between 0 and 100

'                If Diameter# < 0# Then Diameter# = 1#
'                If Diameter# > 3# Then Diameter# = 3#
                'Set the roundness property value in the Graphic
            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmBoltNut
            With frmBoltNut

                Dim BoltProp As Variant
                BoltProp = Graphic.Properties("BoltType")
                If VarType(BoltProp) <> vbEmpty Then
                    i = CInt(BoltProp)
                    .BoltType(i).Value = True
                End If
                Dim NutProp As Variant
                NutProp = Graphic.Properties("NutType")
                If VarType(NutProp) <> vbEmpty Then
                    j = CInt(NutProp)
                    .NutType(j).Value = True
                End If
                iDiam = Graphic.Properties("Diameter")
                .ListDiam.ListIndex = iDiam

                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                'roundness value from the Graphic to the TextBox
                'Get the roundness property value from the Graphic
                'Set the TextBox control's text
NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmBoltNut
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmBoltNut
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If

    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "first point of axis"
    grfThis.Vertices.Add 0#, 0#, 0#, False, True, False, True, False

    'Second Vertex is "Second point of axis"

    grfThis.Vertices.Add 3#, 0#, 0#, False, True, False, True, False

    grfThis.Properties("LimitVertices") = 2
    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis As Object)
        'Setup error handler
        On Error GoTo Failed

        'Set up lock (prevent recursion)
        Dim LockCount&
        LockCount& = grfThis.RegenLock

        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
            grfThis.Graphics.Clear gfCosmetic

            Dim BoltType As Long
            BoltType = grfThis.Properties("BoltType")
            Dim NutType As Long
            NutType = grfThis.Properties("NutType")
            Dim iDiam%
            iDiam = grfThis.Properties("Diameter")

            Dim dd#, D#, H#, T#, j#, del#, E#, F#
            Dim HBolt, HNut, HWasher
            dd = CDbl(frmBoltNut.ListDiam.List(iDiam))
       Dim Salp#, Calp#, L#, alp#
            Dim X00#, Y00#, X01#, Y01#
            With grfThis.Vertices
                X00 = .Item(0).X
                Y00 = .Item(0).Y
                X01 = .Item(1).X
                Y01 = .Item(1).Y
                L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
                Salp = (Y01 - Y00) / L
                Calp = (X01 - X00) / L
            End With

       If Calp = 0# Then
          If Salp > 0 Then
              alp = Pi / 2#
              GoTo LL
          End If
          If Salp < 0 Then
              alp = 3# * Pi / 2#
              GoTo LL
          End If
       End If

       If Salp >= 0# And Calp > 0# Then
          alp = Atn(Abs(Salp / Calp))
       End If
       If Salp >= 0# And Calp < 0# Then
          alp = Pi - Atn(Abs(Salp / Calp))
       End If
       If Salp <= 0# And Calp < 0# Then
          alp = Pi + Atn(Abs(Salp / Calp))
       End If
       If Salp <= 0# And Calp > 0# Then
          alp = 2# * Pi - Atn(Abs(Salp / Calp))
       End If
LL:

       Dim X0(30) As Double
       Dim Y0(30) As Double
       Dim X(30) As Double
       Dim Y(30) As Double

       Dim i As Integer
       Dim grfChild As Object

 ' Slotted Countersunk Bolt  Slotted Countersunk Bolt  Slotted Countersunk Bolt
 ' Slotted Countersunk Bolt  Slotted Countersunk Bolt  Slotted Countersunk Bolt

    If BoltType = 0 Then

                D = 1.875 * dd
                H = 0.494 * dd
                T = 0.24 * dd
                j = 0.19 * dd
                del = 0.1 * dd
                HBolt = H
 ' Head of the Bolt
       X0(1) = H
       Y0(1) = dd / 2#

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = 0#
       Y0(3) = D / 2#

       X0(4) = X0(3)
       Y0(4) = -Y0(3)

       X0(5) = X0(3)
       Y0(5) = j / 2#

       X0(6) = X0(3)
       Y0(6) = -Y0(5)

       X0(7) = X0(3) + T
       Y0(7) = Y0(5)

       X0(8) = X0(7)
       Y0(8) = Y0(6)

       For i = 1 To 8
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i

            'Add child Graphics
      '1
       Set grfChild = grfThis.Graphics.AddLineSingle(X(1), Y(1), 0#, X(2), Y(2), 0#)
                  grfChild.Cosmetic = True
       '2
       Set grfChild = grfThis.Graphics.AddLineSingle(X(1), Y(1), 0#, X(3), Y(3), 0#)
                  grfChild.Cosmetic = True
       '3
       Set grfChild = grfThis.Graphics.AddLineSingle(X(2), Y(2), 0#, X(4), Y(4), 0#)
                  grfChild.Cosmetic = True
       '4
       Set grfChild = grfThis.Graphics.AddLineSingle(X(3), Y(3), 0#, X(5), Y(5), 0#)
                  grfChild.Cosmetic = True
       '5
       Set grfChild = grfThis.Graphics.AddLineSingle(X(4), Y(4), 0#, X(6), Y(6), 0#)
                  grfChild.Cosmetic = True
       '6
       Set grfChild = grfThis.Graphics.AddLineSingle(X(5), Y(5), 0#, X(7), Y(7), 0#)
                  grfChild.Cosmetic = True
       '7
       Set grfChild = grfThis.Graphics.AddLineSingle(X(6), Y(6), 0#, X(8), Y(8), 0#)
                  grfChild.Cosmetic = True
       '8
       Set grfChild = grfThis.Graphics.AddLineSingle(X(7), Y(7), 0#, X(8), Y(8), 0#)
                  grfChild.Cosmetic = True
   End If

' Hex Bolt  Hex Bolt  Hex Bolt  Hex Bolt  Hex Bolt  Hex Bolt  Hex Bolt
' Hex Bolt  Hex Bolt  Hex Bolt  Hex Bolt  Hex Bolt  Hex Bolt  Hex Bolt

    If BoltType = 1 Then
                D = 1.75 * dd
                H = 0.65 * dd
                E = 0.8 * H
                F = D / 4#
                del = 0.1 * dd
                HBolt = H

'-----------------------------------------------------------
  ' Head of the Bolt
       X0(1) = H
       Y0(1) = D / 2#

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = X0(1)
       Y0(3) = F

       X0(4) = X0(1)
       Y0(4) = -Y0(3)

       X0(5) = H - E
       Y0(5) = D / 2#

       X0(6) = X0(5)
       Y0(6) = -Y0(5)

       X0(7) = 0#
       Y0(7) = D / 2# - (H - E)

       X0(8) = X0(7)
       Y0(8) = -Y0(7)

       X0(9) = X0(5)
       Y0(9) = Y0(3)

       X0(10) = X0(9)
       Y0(10) = -Y0(9)

       X0(11) = 0#
       Y0(11) = 3# / 2# * F

       X0(12) = X0(11)
       Y0(12) = 0#

       X0(13) = X0(11)
       Y0(13) = -Y0(11)

       For i = 1 To 13
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i

            'Add child Graphics
'---------------------------------------------------------
       '6
       Set grfChild = grfThis.Graphics.AddLineSingle(X(1), Y(1), 0#, X(2), Y(2), 0#)
                  grfChild.Cosmetic = True
       '7
       Set grfChild = grfThis.Graphics.AddLineSingle(X(1), Y(1), 0#, X(5), Y(5), 0#)
                  grfChild.Cosmetic = True
       '8
       Set grfChild = grfThis.Graphics.AddLineSingle(X(2), Y(2), 0#, X(6), Y(6), 0#)
                  grfChild.Cosmetic = True
       '9
       Set grfChild = grfThis.Graphics.AddLineSingle(X(3), Y(3), 0#, X(9), Y(9), 0#)
                  grfChild.Cosmetic = True
       '10
       Set grfChild = grfThis.Graphics.AddLineSingle(X(4), Y(4), 0#, X(10), Y(10), 0#)
                  grfChild.Cosmetic = True
       '11
       Set grfChild = grfThis.Graphics.AddLineSingle(X(7), Y(7), 0#, X(8), Y(8), 0#)
                  grfChild.Cosmetic = True
       '12
       Set grfChild = grfThis.Graphics.AddLineSingle(X(5), Y(5), 0#, X(7), Y(7), 0#)
                  grfChild.Cosmetic = True
       '13
       Set grfChild = grfThis.Graphics.AddLineSingle(X(6), Y(6), 0#, X(8), Y(8), 0#)
                  grfChild.Cosmetic = True
       '14
       Set grfChild = grfThis.Graphics.AddArcTriplePoint(X(5), Y(5), 0#, X(11), Y(11), 0#, X(9), Y(9), 0#)
                  grfChild.Cosmetic = True
       '15
       Set grfChild = grfThis.Graphics.AddArcTriplePoint(X(9), Y(9), 0#, X(12), Y(12), 0#, X(10), Y(10), 0#)
                  grfChild.Cosmetic = True
       '16
       Set grfChild = grfThis.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, X(13), Y(13), 0#, X(6), Y(6), 0#)
                  grfChild.Cosmetic = True

   End If

 ' Hex Nut  Hex Nut  Hex Nut  Hex Nut  Hex Nut  Hex Nut  Hex Nut
 ' Hex Nut  Hex Nut  Hex Nut  Hex Nut  Hex Nut  Hex Nut  Hex Nut

   If NutType = 0 Then
                D = 1.8 * dd
                H = 0.875 * dd
                E = 0.8 * H
                F = D / 4#
                del = (H - E) / 2#
                HNut = H

       X0(1) = L - HNut - dd / 4#
       Y0(1) = -D / 2# + del

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = X0(1) + del
       Y0(3) = Y0(2) + del

       X0(4) = X0(1) + H - del
       Y0(4) = Y0(3)

       X0(5) = X0(1) + H
       Y0(5) = Y0(4) - del

       X0(6) = X0(5)
       Y0(6) = -Y0(5)

       X0(7) = X0(6) - del
       Y0(7) = -Y0(4)

       X0(8) = X0(1) + del
       Y0(8) = -Y0(3)

       X0(9) = X0(1)
       Y0(9) = 3# / 2# * F

       X0(10) = X0(1)
       Y0(10) = 0#

       X0(11) = X0(1)
       Y0(11) = -Y0(9)

       X0(12) = X0(1) + del
       Y0(12) = F

       X0(13) = X0(12)
       Y0(13) = -Y0(12)

       X0(14) = X0(12) + E
       Y0(14) = Y0(12)

       X0(15) = X0(14)
       Y0(15) = Y0(13)

       X0(16) = X0(5)
       Y0(16) = Y0(9)

       X0(17) = X0(5)
       Y0(17) = Y0(10)

       X0(18) = X0(5)
       Y0(18) = Y0(11)

       For i = 1 To 18
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i
      '1
       Set grfChild = grfThis.Graphics.AddLineSingle(X(1), Y(1), 0#, X(2), Y(2), 0#)
                  grfChild.Cosmetic = True
      '2
       Set grfChild = grfThis.Graphics.AddLineSingle(X(2), Y(2), 0#, X(3), Y(3), 0#)
                  grfChild.Cosmetic = True
      '3
       Set grfChild = grfThis.Graphics.AddLineSingle(X(3), Y(3), 0#, X(4), Y(4), 0#)
                  grfChild.Cosmetic = True
      '4
       Set grfChild = grfThis.Graphics.AddLineSingle(X(4), Y(4), 0#, X(5), Y(5), 0#)
                  grfChild.Cosmetic = True
      '5
       Set grfChild = grfThis.Graphics.AddLineSingle(X(5), Y(5), 0#, X(6), Y(6), 0#)
                  grfChild.Cosmetic = True
      '6
       Set grfChild = grfThis.Graphics.AddLineSingle(X(6), Y(6), 0#, X(7), Y(7), 0#)
                  grfChild.Cosmetic = True
      '7
       Set grfChild = grfThis.Graphics.AddLineSingle(X(7), Y(7), 0#, X(8), Y(8), 0#)
                  grfChild.Cosmetic = True
      '8
       Set grfChild = grfThis.Graphics.AddLineSingle(X(8), Y(8), 0#, X(1), Y(1), 0#)
                  grfChild.Cosmetic = True
'---------------------------------------------------------------
       '9
       Set grfChild = grfThis.Graphics.AddLineSingle(X(13), Y(13), 0#, X(15), Y(15), 0#)
                  grfChild.Cosmetic = True
       '10
       Set grfChild = grfThis.Graphics.AddLineSingle(X(12), Y(12), 0#, X(14), Y(14), 0#)
                  grfChild.Cosmetic = True
'-----------------------------------------------------------------
       '11
       Set grfChild = grfThis.Graphics.AddArcTriplePoint(X(3), Y(3), 0#, X(9), Y(9), 0#, X(12), Y(12), 0#)
                  grfChild.Cosmetic = True
       '12
       Set grfChild = grfThis.Graphics.AddArcTriplePoint(X(12), Y(12), 0#, X(10), Y(10), 0#, X(13), Y(13), 0#)
                  grfChild.Cosmetic = True
       '13
       Set grfChild = grfThis.Graphics.AddArcTriplePoint(X(13), Y(13), 0#, X(11), Y(11), 0#, X(8), Y(8), 0#)
                  grfChild.Cosmetic = True
       '14
       Set grfChild = grfThis.Graphics.AddArcTriplePoint(X(4), Y(4), 0#, X(16), Y(16), 0#, X(14), Y(14), 0#)
                  grfChild.Cosmetic = True
       '15
       Set grfChild = grfThis.Graphics.AddArcTriplePoint(X(14), Y(14), 0#, X(17), Y(17), 0#, X(15), Y(15), 0#)
                  grfChild.Cosmetic = True
       '16
       Set grfChild = grfThis.Graphics.AddArcTriplePoint(X(15), Y(15), 0#, X(18), Y(18), 0#, X(7), Y(7), 0#)
                  grfChild.Cosmetic = True

 ' End Of Bolt  End Of Bolt  End Of Bolt  End Of Bolt
       del = 0.1 * dd

       X0(1) = L - dd / 4#
       Y0(1) = dd / 2#

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = X0(1) + dd / 4# - del
       Y0(3) = dd / 2#

       X0(4) = X0(3)
       Y0(4) = -Y0(3)

       X0(5) = X0(3) + del
       Y0(5) = dd / 2# - del

       X0(6) = X0(5)
       Y0(6) = -Y0(5)

       X0(7) = X0(1)
       Y0(7) = Y0(1) - del

       X0(8) = X0(7)
       Y0(8) = -Y0(7)

       X0(9) = X0(5) + 2#
       Y0(9) = 0#

       For i = 1 To 9
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i

       '0
       Set grfChild = grfThis.Graphics.AddLineSingle(X(3), Y(3), 0#, X(4), Y(4), 0#)
                  grfChild.Cosmetic = True
      '1
       Set grfChild = grfThis.Graphics.AddLineSingle(X(1), Y(1), 0#, X(3), Y(3), 0#)
                  grfChild.Cosmetic = True
       '2
       Set grfChild = grfThis.Graphics.AddLineSingle(X(2), Y(2), 0#, X(4), Y(4), 0#)
                  grfChild.Cosmetic = True
       '3
       Set grfChild = grfThis.Graphics.AddLineSingle(X(3), Y(3), 0#, X(5), Y(5), 0#)
                  grfChild.Cosmetic = True
       '4
       Set grfChild = grfThis.Graphics.AddLineSingle(X(4), Y(4), 0#, X(6), Y(6), 0#)
                  grfChild.Cosmetic = True
       '5
       Set grfChild = grfThis.Graphics.AddLineSingle(X(5), Y(5), 0#, X(6), Y(6), 0#)
                  grfChild.Cosmetic = True
'--------------------

        '6
       Set grfChild = grfThis.Graphics.AddLineSingle(X(5), Y(5), 0#, X(7), Y(7), 0#)
                  grfChild.Cosmetic = True
        '7
       Set grfChild = grfThis.Graphics.AddLineSingle(X(6), Y(6), 0#, X(8), Y(8), 0#)
                  grfChild.Cosmetic = True
'----------------------------------------------------

' Middle of Bolt

       X0(1) = HBolt
       Y0(1) = dd / 2#

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = L - HNut - dd / 4#
       Y0(3) = Y0(1)

       X0(4) = X0(3)
       Y0(4) = Y0(2)
' Threads
       X0(5) = (X0(1) + X0(3)) / 2#
       Y0(5) = Y0(1)

       X0(6) = X0(5)
       Y0(6) = -Y0(5)

       X0(7) = X0(5)
       Y0(7) = Y0(1) - del

       X0(8) = X0(5)
       Y0(8) = -Y0(7)

       X0(9) = X0(3)
       Y0(9) = Y0(7)

       X0(10) = X0(9)
       Y0(10) = -Y0(9)

       For i = 1 To 10
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i
      '1
       Set grfChild = grfThis.Graphics.AddLineSingle(X(1), Y(1), 0#, X(3), Y(3), 0#)
                  grfChild.Cosmetic = True
      '2
       Set grfChild = grfThis.Graphics.AddLineSingle(X(2), Y(2), 0#, X(4), Y(4), 0#)
                  grfChild.Cosmetic = True
      '3
       Set grfChild = grfThis.Graphics.AddLineSingle(X(5), Y(5), 0#, X(6), Y(6), 0#)
                  grfChild.Cosmetic = True
      '4
       Set grfChild = grfThis.Graphics.AddLineSingle(X(7), Y(7), 0#, X(9), Y(9), 0#)
                  grfChild.Cosmetic = True
      '5
       Set grfChild = grfThis.Graphics.AddLineSingle(X(8), Y(8), 0#, X(10), Y(10), 0#)
                  grfChild.Cosmetic = True

    End If

' Low Crown Nut  Low Crown Nut  Low Crown Nut  Low Crown Nut  Low Crown Nut
' Low Crown Nut  Low Crown Nut  Low Crown Nut  Low Crown Nut  Low Crown Nut

   If NutType = 1 Then

                D = 1.66 * dd
                H = 0.72 * dd
                E = 0.8 * H
                F = D / 4#
                del = (H - E) / 2#
                HNut = H + (D / 2# - del) * 1.2

       X0(1) = L - HNut
       Y0(1) = -D / 2# + del

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = X0(1) + del
       Y0(3) = Y0(2) + del

       X0(4) = X0(1) + H - del
       Y0(4) = Y0(3)

       X0(5) = X0(1) + H
       Y0(5) = Y0(4) - del

       X0(6) = X0(5)
       Y0(6) = -Y0(5)

       X0(7) = X0(6) - del
       Y0(7) = -Y0(4)

       X0(8) = X0(1) + del
       Y0(8) = -Y0(3)

       X0(9) = X0(1)
       Y0(9) = 3# / 2# * F

       X0(10) = X0(1)
       Y0(10) = 0#

       X0(11) = X0(1)
       Y0(11) = -Y0(9)

       X0(12) = X0(1) + del
       Y0(12) = F

       X0(13) = X0(12)
       Y0(13) = -Y0(12)

       X0(14) = X0(12) + E
       Y0(14) = Y0(12)

       X0(15) = X0(14)
       Y0(15) = Y0(13)

       X0(16) = X0(5)
       Y0(16) = Y0(9)

       X0(17) = X0(5)
       Y0(17) = Y0(10)

       X0(18) = X0(5)
       Y0(18) = Y0(11)

       X0(19) = X0(17) + (Y0(5) - Y0(17)) * 1.2
       Y0(19) = 0#

       For i = 1 To 19
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i
      '1
       Set grfChild = grfThis.Graphics.AddLineSingle(X(1), Y(1), 0#, X(2), Y(2), 0#)
                  grfChild.Cosmetic = True
      '2
       Set grfChild = grfThis.Graphics.AddLineSingle(X(2), Y(2), 0#, X(3), Y(3), 0#)
                  grfChild.Cosmetic = True
      '3
       Set grfChild = grfThis.Graphics.AddLineSingle(X(3), Y(3), 0#, X(4), Y(4), 0#)
                  grfChild.Cosmetic = True
      '4
       Set grfChild = grfThis.Graphics.AddLineSingle(X(4), Y(4), 0#, X(5), Y(5), 0#)
                  grfChild.Cosmetic = True
      '5
       Set grfChild = grfThis.Graphics.AddArcRotatedElliptical(X(17), Y(17), 0#, X(5), Y(5), 0#, X(19), Y(19), 0#, Pi, 2# * Pi)
                  grfChild.Cosmetic = True
      '6
       Set grfChild = grfThis.Graphics.AddLineSingle(X(6), Y(6), 0#, X(7), Y(7), 0#)
                  grfChild.Cosmetic = True
      '7
       Set grfChild = grfThis.Graphics.AddLineSingle(X(7), Y(7), 0#, X(8), Y(8), 0#)
                  grfChild.Cosmetic = True
      '8
       Set grfChild = grfThis.Graphics.AddLineSingle(X(8), Y(8), 0#, X(1), Y(1), 0#)
                  grfChild.Cosmetic = True
'---------------------------------------------------------------
       '9
       Set grfChild = grfThis.Graphics.AddLineSingle(X(13), Y(13), 0#, X(15), Y(15), 0#)
                  grfChild.Cosmetic = True
       '10
       Set grfChild = grfThis.Graphics.AddLineSingle(X(12), Y(12), 0#, X(14), Y(14), 0#)
                  grfChild.Cosmetic = True
'-----------------------------------------------------------------
       '11
       Set grfChild = grfThis.Graphics.AddArcTriplePoint(X(3), Y(3), 0#, X(9), Y(9), 0#, X(12), Y(12), 0#)
                  grfChild.Cosmetic = True
       '12
       Set grfChild = grfThis.Graphics.AddArcTriplePoint(X(12), Y(12), 0#, X(10), Y(10), 0#, X(13), Y(13), 0#)
                  grfChild.Cosmetic = True
       '13
       Set grfChild = grfThis.Graphics.AddArcTriplePoint(X(13), Y(13), 0#, X(11), Y(11), 0#, X(8), Y(8), 0#)
                  grfChild.Cosmetic = True
       '14
       Set grfChild = grfThis.Graphics.AddArcTriplePoint(X(4), Y(4), 0#, X(16), Y(16), 0#, X(14), Y(14), 0#)
                  grfChild.Cosmetic = True
       '15
       Set grfChild = grfThis.Graphics.AddArcTriplePoint(X(14), Y(14), 0#, X(17), Y(17), 0#, X(15), Y(15), 0#)
                  grfChild.Cosmetic = True
       '16
       Set grfChild = grfThis.Graphics.AddArcTriplePoint(X(15), Y(15), 0#, X(18), Y(18), 0#, X(7), Y(7), 0#)
                  grfChild.Cosmetic = True

'----------------------------------------------------

' Middle of Bolt

       X0(1) = HBolt
       Y0(1) = dd / 2#

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = L - HNut
       Y0(3) = Y0(1)

       X0(4) = X0(3)
       Y0(4) = Y0(2)
' Threads
       X0(5) = (X0(1) + X0(3)) / 2#
       Y0(5) = Y0(1)

       X0(6) = X0(5)
       Y0(6) = -Y0(5)

       X0(7) = X0(5)
       Y0(7) = Y0(1) - del

       X0(8) = X0(5)
       Y0(8) = -Y0(7)

       X0(9) = X0(3)
       Y0(9) = Y0(7)

       X0(10) = X0(9)
       Y0(10) = -Y0(9)

       For i = 1 To 10
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i
      '1
       Set grfChild = grfThis.Graphics.AddLineSingle(X(1), Y(1), 0#, X(3), Y(3), 0#)
                  grfChild.Cosmetic = True
      '2
       Set grfChild = grfThis.Graphics.AddLineSingle(X(2), Y(2), 0#, X(4), Y(4), 0#)
                  grfChild.Cosmetic = True
      '3
       Set grfChild = grfThis.Graphics.AddLineSingle(X(5), Y(5), 0#, X(6), Y(6), 0#)
                  grfChild.Cosmetic = True
      '4
       Set grfChild = grfThis.Graphics.AddLineSingle(X(7), Y(7), 0#, X(9), Y(9), 0#)
                  grfChild.Cosmetic = True
      '5
       Set grfChild = grfThis.Graphics.AddLineSingle(X(8), Y(8), 0#, X(10), Y(10), 0#)
                  grfChild.Cosmetic = True

   End If

            'Add visible child Graphics
        End If

        grfThis.RegenUnlock
        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:

        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function


Examples - Bolts and Nuts Regen - frmBoltNut.frm

frmBoltNut.frm

Bolts and Nuts Regen Example

VERSION 5.00
Begin VB.Form frmBoltNut
   Caption         =   "Bolt-Nut"
   ClientHeight    =   2955
   ClientLeft      =   6435
   ClientTop       =   2910
   ClientWidth     =   3465
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2955
   ScaleWidth      =   3465
   Begin VB.ListBox ListDiam
      Height          =   2010
      ItemData        =   "frmBoltNut.frx":0000
      Left            =   1920
      List            =   "frmBoltNut.frx":0049
      TabIndex        =   8
      Top             =   240
      Width           =   1452
   End
   Begin VB.Frame Frame2
      Caption         =   "NutType"
      Height          =   1092
      Left            =   240
      TabIndex        =   5
      Top             =   1320
      Width           =   1452
      Begin VB.OptionButton NutType
         Caption         =   "Crown Nut"
         Height          =   372
         Index           =   1
         Left            =   120
         TabIndex        =   7
         Top             =   600
         Width           =   1092
      End
      Begin VB.OptionButton NutType
         Caption         =   "Hex Nut"
         Height          =   252
         Index           =   0
         Left            =   120
         TabIndex        =   6
         Top             =   240
         Width           =   1215
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "BoltType"
      Height          =   1092
      Left            =   240
      TabIndex        =   2
      Top             =   120
      Width           =   1455
      Begin VB.OptionButton BoltType
         Caption         =   "Hex Bolt"
         Height          =   252
         Index           =   1
         Left            =   120
         TabIndex        =   4
         Top             =   720
         Width           =   1095
      End
      Begin VB.OptionButton BoltType
         Caption         =   "Slotted  Bolt"
         Height          =   252
         Index           =   0
         Left            =   120
         TabIndex        =   3
         Top             =   240
         Width           =   1215
      End
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   2520
      Width           =   1335
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   2040
      TabIndex        =   1
      Top             =   2520
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "Diameter"
      Height          =   252
      Left            =   2160
      TabIndex        =   9
      Top             =   0
      Width           =   852
   End
End
Attribute VB_Name = "frmBoltNut"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Me.Hide
End Sub

Private Sub Form_Load()
'    frmBoltNut.ListDiam.ListIndex = iDiam
End Sub

Private Sub ListDiam_Click()
'    iDiam = frmBoltNut.ListDiam.ListIndex
End Sub


Examples - Bolts and Nuts Regen - modBoltNut.bas

modBoltNut.bas

Bolts and Nuts Regen Example

Attribute VB_Name = "modBoltNut"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
'Global iDiam%
' DLL Entry point
Sub Main()
'    iDiam = 8
End Sub


Examples - Bolts and Nuts Regen - ScriptB_N.bas

ScriptB_N.bas

Bolts and Nuts Regen Example

'Script to create RRect Turbo Shape and add it to a TurboCAD drawing
Global Const gkGRAPHIC = &H0B
sub Main()
    Dim g As Long
    Dim r As Long
    Dim v As Long

    Dim e As String

    'Create a graphic with kind = gkGraphic and Regen Method
    'RRect.Rectangle.  TCWGraphicCreate will cause OnNewGraphic
    'to be called
    g = TCWGraphicCreate(gkGraphic, "BoltNut.Detail")

    'if we got an error, display error message and stop
    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
        stop
    end if

    'Need up update properties to get RegenGraphic to be called
    e = TCWGraphicPropertySet(g, "PenColor", &H00FF0000)

    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if

    'Add the graphic to the drawing
    TCWGraphicAppend 0, g

    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if

    'Force the graphic to be drawn on the drawing
    TCWGraphicDraw g, 0
    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if
end Sub


Examples - Cable Regen - clsCable.cls

clsCable.cls

Cable Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Length"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2000                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idLength = 1

'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 1
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "Cable"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{50F5B6D0-9628-11d1-A40A-0000B465872B}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
    Names(0) = "Length"
    Types(0) = typeDouble
    IDs(0) = idLength
    Defaults(0) = S
    GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmCable
    Names(0) = frmCable.Caption
    Unload frmCable

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
    GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed

        Dim Length#
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmCable
                'Need On Error statement for the case where you have
                'Length Turbo Shape and ahother "shape" selected
                On Error Resume Next

                'When the property page is closed, transfer the numeric
                'Length value from the TextBox to the Graphic
                'Get the value as a double-precision number
                Length# = CDbl(.txtLength.Text)
                'Make sure it's between 0 and 100
                If Length# < 0# Then Length# = 0#
                'Set the Length property value in the Graphic
                Graphic.Properties("Length") = Length#
            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmCable
            With frmCable
                'If more than one Length is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                ' Length value from the Graphic to the TextBox
                'Get the Length property value from the Graphic
                Length# = Graphic.Properties("Length")
                'Set the TextBox control's text
                .txtLength.Text = Length#
NoRType:
            End With
        End If
        S = Length
        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmCable
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmCable
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If
    xx0 = 4#
    yy0 = 5#
    zz0 = 0#
    xx1 = 8#
    yy1 = 8#
    dxx = 4#
    dyy = 4#
    S = 8#
    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "left" point
    grfThis.Vertices.Add xx0, yy0, 0#, False, True, True, True, True
    'Second Vertex is "right" point
    grfThis.Vertices.Add xx1, yy1, 0#, False, True, True, True, True

    grfThis.Properties("LimitVertices") = 2
    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis As Object)
        'Setup error handler
        On Error GoTo Failed

        'Set up lock (prevent recursion)
        Dim LockCount&
        LockCount& = grfThis.RegenLock

        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
            grfThis.Graphics.Clear gfCosmetic

            Dim boolHandleMoved As Boolean

            Dim W#, H#, R#, Length#

            'Add child Graphics
            Dim grfChild As Object
            Dim x#, y#, z#, xz#
            With grfThis.Vertices
                xx0 = .Item(0).x
                yy0 = .Item(0).y
                zz0 = .Item(0).z

                xx1 = .Item(1).x
                yy1 = .Item(1).y
                zz1 = .Item(0).z
            End With

            dxx = xx1 - xx0
            dyy = yy1 - yy0
            dzz = zz1 - zz0
            dxz = Sqr(dxx * dxx + dzz * dzz)
            Dim Sina#, Cosa#
            Sina = dzz / dxz
            Cosa = dxx / dxz

            If S * S < (dxx * dxx + dyy * dyy + dzz * dzz) Then
'                MsgBox ("Length must be more then " & CStr(Sqr(dxx * dxx + dyy * dyy + dzz * dzz)))
                S = 1.001 * Sqr(dxx * dxx + dyy * dyy + dzz * dzz)
                grfThis.Properties("Length") = Format(S, "###0.00")
                frmCable.txtLength.Text = Format(S, "###0.00")
                Length = S
            End If
            a = Nonline_equ(1#)
            Dim e#
            e = Exp(dxz / a)
            z = dyy / a / (e - 1) + Sqr(Square(dyy / a / (e - 1#)) - (1# / e - 1#) / (e - 1#))
            xzn = a * Log(z)
            e = Exp(xzn / a)
            yyn = a / 2# * (e + 1# / e) - a
            xzk = xzn + dxz
            e = Exp(xzk / a)
            yyk = a / 2# * (e + 1# / e) - a
            Dim xa(11) As Variant, ya(11) As Variant, za(11) As Variant
            Dim i As Long, i1 As Long
            i = 0

            For xz = xzn To xzk + 0.01 * dxz Step dxz / 10#
                e = Exp(xz / a)
                y = a / 2# * (e + 1# / e) - a
                xa(i) = xz * Cosa + (xx0 - xzn * Cosa)
                ya(i) = y + (yy0 - yyn)
                za(i) = xz * Sina * Sign(dzz) + (zz0 - xzn * Sina + Sign(dzz))
                i = i + 1
            Next xz
 Set grfChild = grfThis.Graphics.AddCurveBezier(xa(0), ya(0), za(0))
                grfChild.Cosmetic = True
 Dim Ver As Object

 For i = 1 To 10
   Set Ver = grfChild.Vertices.Add(xa(i), ya(i), za(i))
 Next i

 i = 0
  Set grfChild = grfThis.Graphics.AddCircleCenterAndPoint(xa(i), ya(i), za(i), xa(i), ya(i) + 0.05, za(i))
                grfChild.Cosmetic = True
 i = 10
  Set grfChild = grfThis.Graphics.AddCircleCenterAndPoint(xa(i), ya(i), za(i), xa(i), ya(i) + 0.05, za(i))
                grfChild.Cosmetic = True
  i = 3
  Set grfChild = grfThis.Graphics.AddLineSingle(xa(i), ya(i), za(i), xa(i), ya(i) - 0.5, za(i))
                grfChild.Cosmetic = True
  Set grfChild = grfThis.Graphics.Add(, "TCW40SPHERE")
                grfChild.Properties("Solid") = 0
                grfChild.Cosmetic = True
  Set Ver = grfChild.Vertices.Add(xa(i), ya(i) - 0.8, za(i))
  Set Ver = grfChild.Vertices.Add(xa(i), ya(i) - 0.5, za(i))

 i = 5
  Set grfChild = grfThis.Graphics.AddLineSingle(xa(i), ya(i), za(i), xa(i), ya(i) - 0.5, za(i))
                grfChild.Cosmetic = True
  Set grfChild = grfThis.Graphics.Add(, "TCW40SPHERE")
                grfChild.Properties("Solid") = 0
                grfChild.Cosmetic = True
  Set Ver = grfChild.Vertices.Add(xa(i), ya(i) - 0.8, za(i))
  Set Ver = grfChild.Vertices.Add(xa(i), ya(i) - 0.5, za(i))
 i = 7
  Set grfChild = grfThis.Graphics.AddLineSingle(xa(i), ya(i), za(i), xa(i), ya(i) - 0.5, za(i))
                grfChild.Cosmetic = True
  Set grfChild = grfThis.Graphics.Add(, "TCW40SPHERE")
                grfChild.Properties("Solid") = 0
                grfChild.Cosmetic = True
  Set Ver = grfChild.Vertices.Add(xa(i), ya(i) - 0.8, za(i))
  Set Ver = grfChild.Vertices.Add(xa(i), ya(i) - 0.5, za(i))

            'Add visible child Graphics
        End If

        grfThis.RegenUnlock
        'grfThis.Application.PopVertexDefaults
        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:
        'grfThis.Application.PopVertexDefaults

        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function
Public Function Nonline_equ(y#) As Double

    Dim y1#, y2#, y12#, f1#, f2#, f12#, dy#
    dy = 0.11
    Dim pr%

    y1 = y
    f1 = func(y1)
    y2 = y1 + dy
    f2 = func(y2)

    If f2 > f1 Then
        pr = 1
    Else
        pr = 2
    End If

    If pr = 1 Then
        If f1 > 0# Then
            y2 = y1 - dy
            f2 = func(y2)
L1:
            If f2 > 0# Then
                y2 = y2 - dy
                f2 = func(y2)
                GoTo L1
            End If
        Else
L2:
            If f2 < 0 Then
                y2 = y2 + dy
                f2 = func(y2)
                GoTo L2
            End If
        End If
    Else
        If f1 < 0# Then
            y2 = y1 - dy
            f2 = func(y2)
L3:
            If f2 < 0 Then
                y2 = y2 - dy
                f2 = func(y2)
                GoTo L3
            End If
        Else
L4:
            If f2 > 0 Then
                y2 = y2 + dy
                f2 = func(y2)
                GoTo L4
            End If
        End If
    End If

L5:
    y12 = (y1 + y2) / 2#
    f12 = func(y12)
    If Absr(y1 - y2) > 0.000001 Then
        If Sign(f12) = Sign(f1) Then
            y1 = y12
            GoTo L5
        Else
            y2 = y12
            GoTo L5
        End If
    End If
    Nonline_equ = y12

End Function

Public Function Square(y As Double) As Double

    Square = y * y

End Function

Public Function func(y As Double) As Double
    Dim f#, z#, e#
    e = Exp(dxz / y)
    z = dyy / y / (e - 1#) + Sqr(Square(dyy / y / (e - 1#)) - (1# / e - 1#) / (e - 1#))
    func = y / 2# * (z * (e - 1#) - 1# / z * (1# / e - 1#)) - S

End Function

Public Function Sign(y As Double) As Double

    If y > 0# Then
        Sign = 1#
    End If
    If y < 0# Then
        Sign = -1#
    End If
    If y = 0# Then
        Sign = 0#
    End If

End Function

Public Function Absr(y As Double) As Double

    If y > 0# Then
        Absr = y
    Else
        Absr = -y
    End If

End Function


Examples - Cable Regen - frmCable.frm

frmCable.frm

Cable Regen Example

VERSION 5.00
Begin VB.Form frmCable
   Caption         =   "Cable"
   ClientHeight    =   1470
   ClientLeft      =   6435
   ClientTop       =   2910
   ClientWidth     =   3465
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   1470
   ScaleWidth      =   3465
   Begin VB.TextBox txtLength
      Height          =   285
      Left            =   1680
      TabIndex        =   3
      Text            =   "8"
      Top             =   240
      Width           =   615
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   840
      Width           =   1335
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   1920
      TabIndex        =   1
      Top             =   840
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "Length"
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   240
      Width           =   1095
   End
End
Attribute VB_Name = "frmCable"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Me.Hide
End Sub


Examples - Cable Regen - modCable.bas

modCable.bas

Cable Regen Example

Attribute VB_Name = "modCable"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
Global xx0#, yy0#, zz0#, xx1#, yy1#, zz1#
Global xzn#, yyn#, xzk#, yyk#, dxx#, dyy#, dzz#, dxz#
Global S#, a#
Global pi#

' DLL Entry point
Sub Main()
pi = 3.14159

End Sub


Examples - Cable Regen - ScriptCable.bas

ScriptCable.bas

Cable Regen Example

'Script to create RRect Turbo Shape and add it to a TurboCAD drawing
Global Const gkGRAPHIC = &H0B
sub Main()
    Dim g As Long
    Dim r As Long
    Dim v As Long

    Dim e As String

    'Create a graphic with kind = gkGraphic and Regen Method
    'RRect.Rectangle.  TCWGraphicCreate will cause OnNewGraphic
    'to be called
    g = TCWGraphicCreate(gkGraphic, "Cable.Length")

    'if we got an error, display error message and stop
    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
        stop
    end if

    'Need up update properties to get RegenGraphic to be called
    e = TCWGraphicPropertySet(g, "PenColor", &H00FF0000)

    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if

    'Add the graphic to the drawing
    TCWGraphicAppend 0, g

    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if

    'Force the graphic to be drawn on the drawing
    TCWGraphicDraw g, 0
    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if
end Sub


Examples - Connection Line Regen - CCC.frm

CCC.frm

Connection Line Regen Example

VERSION 5.00
Begin VB.Form Form1
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Connector"
   ClientHeight    =   1545
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   1815
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1545
   ScaleWidth      =   1815
   StartUpPosition =   3  'Windows Default
   Begin VB.CheckBox ArrowSecond
      Caption         =   "Arrow2"
      Height          =   495
      Left            =   360
      TabIndex        =   2
      Top             =   480
      Width           =   1455
   End
   Begin VB.CheckBox ArrowFirst
      Caption         =   "Arrow1"
      Height          =   495
      Left            =   360
      TabIndex        =   1
      Top             =   120
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   1080
      Width           =   1095
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdOK_Click()
    Me.Hide
End Sub


Examples - Connection Line Regen - Conn.bas

Conn.bas

Connection Line Regen Example

Attribute VB_Name = "Module1"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' DLL Entry point
Sub Main()

End Sub


Examples - Connection Line Regen - Line.cls

Line.cls

Connection Line Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Line"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idConnect = 11
Const idConFirst = 12
Const idConSecond = 13
Const idVerFirst = 14
Const idVerSecond = 15
Const idArrowFirst = 16
Const idArrowSecond = 17

'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 7
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "SDK Connector"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{D25185FE-6A20-11d0-A115-00A024158DAE}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
    Names(0) = "OwnCon"
    Types(0) = typeString
    IDs(0) = idConnect
    Defaults(0) = "CONNECT"

    Names(1) = "FirstConID"
    Types(1) = typeLong
    IDs(1) = idConFirst
    Defaults(1) = -1

    Names(2) = "SecondConID"
    Types(2) = typeLong
    IDs(2) = idConSecond
    Defaults(2) = -1

    Names(3) = "FirstVerCon"
    Types(3) = typeLong
    IDs(3) = idVerFirst
    Defaults(3) = -1

    Names(4) = "SecondVerCon"
    Types(4) = typeLong
    IDs(4) = idVerSecond
    Defaults(4) = -1

    Names(5) = "FirstArrow"
    Types(5) = typeInteger
    IDs(5) = idArrowFirst
    Defaults(5) = 0

    Names(6) = "SecondArrow"
    Types(6) = typeInteger
    IDs(6) = idArrowSecond
    Defaults(6) = 0

  GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load Form1
    Names(0) = Form1.Caption
    Unload Form1

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
    GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed
Dim Arrow1%
Dim Arrow2%

        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With Form1
                'Need On Error statement for the case where you have
                'conn Turbo Shape and ahother "shape" selected
                On Error Resume Next

                'When the property page is closed, transfer the numeric
                ' value from the TextBox to the Graphic
                'Get the value as a double-precision number
                'Make sure it's between 0 and 100
                'Set the roundness property value in the Graphic

                Arrow1 = .ArrowFirst.Value
                Graphic.Properties("FirstArrow") = Arrow1

                Arrow2 = .ArrowSecond.Value
                Graphic.Properties("SecondArrow") = Arrow2

            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load Form1
            With Form1
                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                ' value from the Graphic to the TextBox
                'Get the property value from the Graphic
                'Set the TextBox control's text
                Arrow1 = Graphic.Properties("FirstArrow")
                .ArrowFirst.Value = Arrow1

                 Arrow2 = Graphic.Properties("SecondArrow")
                .ArrowSecond.Value = Arrow2

NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False

End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload Form1
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
     With Form1
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With

'        PropertyPages = False

End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean

    Wizard = False

End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If
Dim grfThis1 As Graphic
    Set grfThis1 = grfThis
    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable,Calculated
    'First Vertex is "lower left" corner
    grfThis1.Vertices.Add 1, 1, 0#, False, False, True, True, True, True
    'Second Vertex is "upper right" corner
'    grfThis1.Vertices.Add Xt2, Yt2, 0#, True, False, True, True, True, True
'    grfThis1.Vertices.Add Xt1, (Yt1 + Yt2) / 2#, 0#, True, False, True, True, True, True

'    grfThis1.Vertices.Add Xt2, (Yt1 + Yt2) / 2#, 0#, True, False, True, True, True, True
    grfThis1.Vertices.Add 5, 5, 0#, False, False, True, True, True, True
    grfThis1.Vertices.Add (1 + 5) / 2, (1 + 5) / 2, 0#, False, False, True, True, True, True
   OnNewGraphic = True
   Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function
Private Function LinkAtVertex(ByVal grfThis1 As Object, ByVal ivLink As Long, ByRef grfLink As Object, ivBase As Long) As Boolean
   'Default return value
Dim grfThis As Graphic
    Set grfThis = grfThis1
    LinkAtVertex = False
    Dim Answer As Graphic
    On Error GoTo Errors
Dim i As Long, xV#, yV#, xLink#, yLink#, j As Long, nVLink As Long
Dim TypeCon As String
For i = 0 To 0
    Set Answer = grfThis.GetSubjectLink(ivLink, i)
    Set grfLink = Answer
    TypeCon = " "
On Error Resume Next
   TypeCon = grfLink.Properties("OwnCon")
    If TypeCon <> "CONNECT" Then
        nVLink = grfLink.Vertices.Count - 1
        For j = 0 To nVLink 'grfLink.Vertices.Count - 1
            xV = grfLink.Vertices.Item(j).x
            yV = grfLink.Vertices.Item(j).Y
            xLink = grfThis.Vertices.Item(ivLink).x
            yLink = grfThis.Vertices.Item(ivLink).Y
            If Abs(xV - xLink) < 0.000001 And Abs(yV - yLink) < 0.000001 Then
                ivBase = j
                If ivLink = 0 Then
                    grfThis.Properties("FirstVerCon") = ivBase
                Else
                    grfThis.Properties("SecondVerCon") = ivBase
                End If
            End If
        Next j
    End If
Next i
    LinkAtVertex = True

    Exit Function

Errors:
'    If Err.Number <> 0 Then
'        MsgBox "Error in LinkAtVertex: " & Err.Description
'    End If
    LinkAtVertex = True

End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis As Object)
Dim grfLink0 As Graphic
Dim grfLink1 As Graphic
Dim Arrow1%
Dim Arrow2%
Dim grfThis1 As Graphic
        Set grfThis1 = grfThis
        'Setup error handler
        On Error GoTo Failed
        'Set up lock (prevent recursion)
        Dim LockCount&
        If grfThis1.Vertices.Count = 0 Then
                Exit Function
        End If
        LockCount& = grfThis1.RegenLock

        'Setup error handler (make sure lock is removed)
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
            grfThis1.Graphics.Clear gfCosmetic

            Dim boolHandleMoved As Boolean

            Arrow1 = grfThis1.Properties("FirstArrow")
            Arrow2 = grfThis1.Properties("SecondArrow")

            'Add child Graphics
            Dim grfChild As Graphic
            Dim x0#, y0#, x1#, y1#, x2#, y2#

  Dim linkBool As Boolean
  Dim ivLink0 As Long, ivLink1 As Long
  ivLink0 = -1
  ivLink1 = -1
  linkBool = LinkAtVertex(grfThis1, 0, grfLink0, ivLink0)
  linkBool = LinkAtVertex(grfThis1, 1, grfLink1, ivLink1)
            With grfThis1.Vertices
               x0 = .Item(0).x
               y0 = .Item(0).Y
               x1 = .Item(1).x
               y1 = .Item(1).Y
            End With

Dim x00#, y00#, x11#, y11#, del#
 Dim Ver As Vertex
'#########################################################################
'#########################################################################
            With grfThis1.Vertices
               .Item(2).Selectable = True
               .Item(2).Snappable = True
               .Item(2).Linkable = True
               .Item(2).Editable = True

               x2 = .Item(2).x
               y2 = .Item(2).Y
               .Item(2).x = (x0 + x1) / 2
            End With
            x00 = x0
            y00 = y2
            x11 = x1
            y11 = y2
            Set grfChild = grfThis1.Graphics.Add(11)
            With grfChild.Vertices
                .Add x0, y0, 0
                .Add x0, y2, 0
                .Add x1, y2, 0
                .Add x1, y1, 0
            End With
            grfChild.Cosmetic = True

'#########################################################################
'#########################################################################
' --------------------------------------------------------------------------
Dim L#, sina#, cosa#, xx1#, yy1#, xx2#, yy2#, xx#, yy#
Dim lstr#, hstr#
            lstr = 0.2
            hstr = 0.06
        If Arrow1 = 1 Then
            If Abs(x0 - x00) < 0.00001 And Abs(y0 - y00) < 0.00001 Then
                x00 = x1
                y00 = y1
            End If
            L = Sqr((x0 - x00) * (x0 - x00) + (y0 - y00) * (y0 - y00))
            sina = (y00 - y0) / L
            cosa = (x00 - x0) / L
            xx = x0 - lstr / L * (x0 - x00)
            yy = y0 - lstr / L * (y0 - y00)
            xx1 = xx + hstr * sina
            yy1 = yy - hstr * cosa
            xx2 = xx - hstr * sina
            yy2 = yy + hstr * cosa
            Set grfChild = grfThis1.Graphics.Add(11)
                grfChild.Cosmetic = True
                grfChild.Vertices.Add x0, y0, 0#, True, False, False, False, False, False
                grfChild.Vertices.Add xx1, yy1, 0#, True, False, False, False, False, False
                grfChild.Vertices.Add xx2, yy2, 0#, True, False, False, False, False, False
                grfChild.Vertices.Add x0, y0, 0#, True, False, False, False, False, False
                grfChild.Closed = True
                grfChild.BrushStyle = "Solid"
                grfChild.Properties.Item("BrushColor").Value = RGB(0, 0, 0)
        End If

        If Arrow2 = 1 Then
            If Abs(x1 - x11) < 0.00001 And Abs(y1 - y11) < 0.00001 Then
                x11 = x0
                y11 = y0
            End If
            L = Sqr((x1 - x11) * (x1 - x11) + (y1 - y11) * (y1 - y11))
            sina = (y11 - y1) / L
            cosa = (x11 - x1) / L
            xx = x1 - lstr / L * (x1 - x11)
            yy = y1 - lstr / L * (y1 - y11)
            xx1 = xx + hstr * sina
            yy1 = yy - hstr * cosa
            xx2 = xx - hstr * sina
            yy2 = yy + hstr * cosa
            Set grfChild = grfThis1.Graphics.Add(11)
                grfChild.Cosmetic = True
                grfChild.Vertices.Add x1, y1, 0#, True, False, False, False, False, False
                grfChild.Vertices.Add xx1, yy1, 0#, True, False, False, False, False, False
                grfChild.Vertices.Add xx2, yy2, 0#, True, False, False, False, False, False
                grfChild.Vertices.Add x1, y1, 0#, True, False, False, False, False, False
                grfChild.Closed = True
                grfChild.BrushStyle = "Solid"
                grfChild.Properties.Item("BrushColor").Value = RGB(0, 0, 0)
        End If

  Set grfLink0 = Nothing
  Set grfLink1 = Nothing

            'Add visible child Graphics
        End If

        grfThis1.RegenUnlock
        Exit Function

Failed:
        'grfThis.Application.PopVertexDefaults

        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If
End Function

Public Function Draw(ByVal grfThis1 As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False

End Function

Private Function Sign(x As Double) As Integer
    If Abs(x) < 0.00001 Then Sign = 0
    If x > 0 Then Sign = 1
    If x < 0 Then Sign = -1

End Function


Examples - Coord Text Regen - CoordText.bas

CoordText.bas

Coord Text Regen Example

Attribute VB_Name = "Module1"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1999                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' DLL Entry point
Sub Main()

End Sub


Examples - Coord Text Regen - CoordText.cls

CoordText.cls

Coord Text Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Coordinate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1999                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Property Ids
Const idCoordStyle = 1
Const idTextHeight = 2
Const idMarkSize = 3

'Property enums
Const NUM_TYPES = 3
Const dotted = 0
Const stacked = 1
Const cartesian = 2

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 3
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "SDK Coordinate Text"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{1B91F522-8900-11d0-AFFD-444553540000}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)

    Names(0) = "CoordType"
    Types(0) = typeLong
    IDs(0) = idCoordStyle
    Defaults(0) = dotted

    Names(1) = "TextHeight"
    Types(1) = typeDouble
    IDs(1) = idTextHeight
    Defaults(1) = 0.3

    Names(2) = "MarkSize"
    Types(2) = typeDouble
    IDs(2) = idMarkSize
    Defaults(2) = 0.05

    GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmCoordText
    Names(0) = frmCoordText.Caption
    Unload frmCoordText

    'Set up which property pages we want to see
    StockPages = ppStockPen + ppStockAuto

    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
    If PropID = idCoordStyle Then
        ReDim Names(NUM_TYPES), Values(NUM_TYPES)
        Names(0) = "Dotted"
        Values(0) = dotted
        Names(1) = "Stacked"
        Values(1) = stacked
        Names(2) = "Cartesian"
        Values(2) = cartesian
        GetEnumNames = NUM_TYPES
    Else
        GetEnumNames = 0
    End If
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic1 As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        On Error GoTo Failed
Dim Graphic As Graphic
    Set Graphic = Graphic1
        Dim i%
        If ThisRegenMethod.Name <> Graphic.Type And Graphic.Type <> "GRAPHIC" Then Exit Function
        If SaveProperties Then
           With frmCoordText
                'When the property page is closed,
                'Get properties from the property pages

                For i% = 0 To NUM_TYPES
                    If .CoordType(i%).Value Then
                        Graphic.Properties("CoordType") = i%
                        Exit For
                    End If
                Next i%

                Graphic.Properties("MarkSize") = CDbl(.MarkSize.Text)
                Graphic.Properties("TextHeight") = CDbl(.TxtHeight.Text)

            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmCoordText
            With frmCoordText
                'When the property page is opening,

                Dim CoordProp As Variant

                'If more than one CoordText shape is selected and they
                'do not have the same properties, don't set up this field
                On Error GoTo NoCType
                CoordProp = Graphic.Properties("CoordType")
                If VarType(CoordProp) <> vbEmpty Then
                       i% = CInt(CoordProp)
                       .CoordType(i%).Value = True
                End If
NoCType:
                'If we don't have the same marker size, skip setting up this
                'field also
                On Error GoTo NoMType
                .MarkSize.Text = Graphic.Properties("MarkSize")

NoMType:
                'If we don't have the same text size, skipp setting up
                'this field
                On Error GoTo NoTType
                .TxtHeight.Text = Graphic.Properties("TextHeight")

NoTType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
'            MsgBox "Error in PageControls: " & Err.Description
        End If

        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmCoordText
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmCoordText
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If

    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable

    'First Vertex - "left bottom" - v0
    grfThis.Vertices.Add 0#, 0#, 0#, False, True, True, True, False

    'Limit the number of vertices allowed with this Smart Object
    grfThis.Properties("LimitVertices") = True

    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Regen Graphic
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when graphic's internal structure needs to be updated
Public Function Regen(ByVal grfThis1 As Object)
        'Setup error handler
        On Error Resume Next
        Err.Clear
Dim grfThis As Graphic
        Set grfThis = grfThis1
        'Set up lock
        Dim lockCount&
        lockCount& = grfThis.RegenLock

        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If lockCount& = 0 Then
            'Delete previous cosmetic children
            grfThis.Graphics.Clear gfCosmetic

            Dim Info As String
            Dim X As Double
            Dim Y As Double

            With grfThis.Vertices
                X = .Item(0).X
                Y = .Item(0).Y
            End With
            Dim dx As Double
            dx = grfThis.Properties("MarkSize")
            Dim dy As Double
            dy = dx
            Dim TSize As Double
            TSize = grfThis.Properties("TextHeight")

            Dim itype As Long
            Dim grfText As Object

            ' Make the Cross
            Dim grfLine As Object
            Set grfLine = grfThis.Graphics.AddLineSingle(X - dx, Y, 0, X + dx, Y, 0)
            grfLine.Cosmetic = True

            Set grfLine = grfThis.Graphics.AddLineSingle(X, Y + dy, 0, X, Y - dy, 0)
            grfLine.Cosmetic = True

            itype = grfThis.Properties("CoordType")

            ' Make the Text
            Select Case itype
                Case dotted
                    Info = Format(X, "0") & " "
                    Set grfText = grfThis.Graphics.AddText(Info, X, Y, 0, TSize, 0#)
                    grfText.Cosmetic = True
'                   grfText.Properties("TextFormat") = 2 'Align Right

                    ' Move the X text left of the point by the width of the text
                    Dim mx As Double
                    With grfText.Vertices
                        mx = .Item(3).X - .Item(1).X
                        .Item(0).X = .Item(0).X - mx
                        .Item(1).X = .Item(1).X - mx
                        .Item(2).X = .Item(2).X - mx
                        .Item(3).X = .Item(3).X - mx
                        .Item(4).X = .Item(4).X - mx
                        .Item(5).X = .Item(5).X - mx
                    End With

                    Info = " " & Format(Y, "0")
                    Set grfText = grfThis.Graphics.AddText(Info, X, Y, 0, TSize, 0#)
                    grfText.Cosmetic = True

                Case stacked
                    Info = "X = " & Format(X, "0.00") & Chr(10) & "Y = " & Format(Y, "0.00")
                    Set grfText = grfThis.Graphics.AddText(Info, X, Y, 0, TSize * 2, 0#)

                    grfText.Cosmetic = True

                    ' Move the X text left of the point by the width of the text
                    Dim my As Double
                    With grfText.Vertices
                        my = (.Item(1).Y - .Item(2).Y) / 2#
                        .Item(0).Y = .Item(0).Y - my
                        .Item(1).Y = .Item(1).Y - my
                        .Item(2).Y = .Item(2).Y - my
                        .Item(3).Y = .Item(3).Y - my
                        .Item(4).Y = .Item(4).Y - my
                        .Item(5).Y = .Item(5).Y - my
                    End With
                Case cartesian
                    Info = "(" & Format(X, "0.00") & ", " & Format(Y, "0.00") & ")"
                    Set grfText = grfThis.Graphics.AddText(Info, X, Y, 0, TSize, 0#)
                    grfText.Cosmetic = True

            End Select

        End If

        'Remove lock
        grfThis.RegenUnlock

        Exit Function
FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:

        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If

End Function


Examples - Coord Text Regen - CoordText.frm

CoordText.frm

Coord Text Regen Example

VERSION 5.00
Begin VB.Form frmCoordText
   Caption         =   "Coordinate Text"
   ClientHeight    =   2535
   ClientLeft      =   2445
   ClientTop       =   2910
   ClientWidth     =   3930
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2535
   ScaleWidth      =   3930
   Begin VB.TextBox MarkSize
      Height          =   375
      Left            =   2040
      TabIndex        =   9
      Top             =   1320
      Width           =   1455
   End
   Begin VB.TextBox TxtHeight
      Height          =   375
      Left            =   2040
      TabIndex        =   8
      Top             =   480
      Width           =   1455
   End
   Begin VB.OptionButton CoordType
      Caption         =   "Cartesian"
      Height          =   255
      Index           =   2
      Left            =   360
      TabIndex        =   4
      Top             =   1200
      Width           =   1215
   End
   Begin VB.OptionButton CoordType
      Caption         =   "Stacked"
      Height          =   255
      Index           =   1
      Left            =   360
      TabIndex        =   3
      Top             =   840
      Width           =   1215
   End
   Begin VB.OptionButton CoordType
      Caption         =   "Dotted"
      Height          =   255
      Index           =   0
      Left            =   360
      TabIndex        =   2
      Top             =   480
      Width           =   1215
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   1920
      Width           =   1335
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   2520
      TabIndex        =   1
      Top             =   1920
      Width           =   1215
   End
   Begin VB.Frame Frame1
      Caption         =   "Coordinate Type"
      Height          =   1575
      Left            =   120
      TabIndex        =   5
      Top             =   120
      Width           =   1575
   End
   Begin VB.Label Label2
      Caption         =   "Mark Size"
      Height          =   255
      Left            =   2040
      TabIndex        =   7
      Top             =   1080
      Width           =   1095
   End
   Begin VB.Label Label1
      Caption         =   "Text Height"
      Height          =   255
      Left            =   2040
      TabIndex        =   6
      Top             =   240
      Width           =   975
   End
End
Attribute VB_Name = "frmCoordText"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1999                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Me.Hide
End Sub


Examples - Coord Text Regen - createct.bas

createct.bas

Coord Text Regen Example

'Script to create CoordText Turbo Shape and add it to a TurboCAD drawing
Global Const gkGRAPHIC = &H0B
Global Const cartesian = 2
sub Main()
    Dim g As Long
    Dim r As Long
    Dim v As Long

    Dim e As String

    'Create a graphic with kind = gkGraphic and Regen Method
    'CoordText.TCWCoordText.  TCWGraphicCreate will cause OnNewGraphic
    'to be called
    g = TCWGraphicCreate(gkGraphic, "CoordText.TCWCoordText")

    'if we got an error, display error message and stop
    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
        stop
    end if

    'Need up update properties to get RegenGraphic to be called
    e = TCWGraphicPropertySet(g, "CoordType", cartesian)

    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if

    'Let's change the color of our CoordText shape as well
    e = TCWGraphicPropertySet(g, "PenColor", &H000000FF)

    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if

    'Add the graphic to the drawing
    TCWGraphicAppend 0, g

    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if

    'Force the graphic to be drawn on the drawing
    TCWGraphicDraw g, 0
    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if
end Sub


Examples - Datum Target Regen - DatumTarg.bas

DatumTarg.bas

Datum Target Regen Example

Attribute VB_Name = "Module1"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

Global ImDiam As Integer

' DLL Entry point
Sub Main()
End Sub


Examples - Datum Target Regen - DatumTarg.cls

DatumTarg.cls

Datum Target Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Target"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idDiam = 1
Const idText1 = 2
Const idText2 = 3
Const idText3 = 4
Const idSymbolSize = 5
Const idFontSize = 6

'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 6
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "SDK_DatumTarget"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{FDB6F1CA-9631-11d1-A40A-0000B465872B}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)

    Names(0) = "Diam"
    Types(0) = typeInteger
    IDs(0) = idDiam
    Defaults(0) = 1

    Names(1) = "TagAreaSize"
    Types(1) = typeString
    IDs(1) = idText1
    Defaults(1) = "1"

    Names(2) = "DatumLetter"
    Types(2) = typeString
    IDs(2) = idText2
    Defaults(2) = "A"

    Names(3) = "TargetNumber"
    Types(3) = typeString
    IDs(3) = idText3
    Defaults(3) = "1"

    Names(4) = "SymbolSize"
    Types(4) = typeDouble
    IDs(4) = idSymbolSize
    Defaults(4) = 0.5

    Names(5) = "FontSize"
    Types(5) = typeDouble
    IDs(5) = idFontSize
    Defaults(5) = 0.25

'End Scale
    GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmSample
    Names(0) = frmSample.Caption
    Unload frmSample

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
    GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed
Dim Str1$, Str2$, Str3$, SymbolSize#, FontSize#
Dim FontHeight As Double
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmSample
               'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next

                Graphic.Properties("Diam") = ImDiam
                Str1 = .Text1.Text
                Graphic.Properties("TagAreaSize") = Str1

                Str2 = .Text2.Text
                Graphic.Properties("DatumLetter") = Str2

                Str3 = .Text3.Text
                Graphic.Properties("TargetNumber") = Str3

                SymbolSize = CDbl(.Text4.Text)
                Graphic.Properties("SymbolSize") = SymbolSize

                FontSize = CDbl(.Text5.Text)
                Graphic.Properties("FontSize") = FontSize

            End With

        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmSample
            With frmSample
                'If more than one Rough-symbol is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType
                ImDiam = Graphic.Properties("Diam")

                Str1 = Graphic.Properties("TagAreaSize")
                .Text1.Text = Str1

                Str2 = Graphic.Properties("DatumLetter")
                .Text2.Text = Str2

                Str3 = Graphic.Properties("TargetNumber")
                .Text3.Text = Str3

                SymbolSize = Graphic.Properties("SymbolSize")
                .Text4.Text = CStr(SymbolSize)

                FontSize = Graphic.Properties("FontSize")
                .Text5.Text = CStr(FontSize)
NoRType:
            End With

        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmSample
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmSample
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If
    On Error GoTo Failed
    ImDiam = 1
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "Center" vertex
    grfThis.Vertices.Add 0#, 0#, 0#, False, True, True, False, True
    'Second Vertex is additional
    grfThis.Vertices.Add 1, 0#, 0#, False, True, True, False, True
    'Third Vertex is additional
    grfThis.Vertices.Add 0, 0, 0#, False, True, True, True, True
    'Forth Vertex is additional
    grfThis.Vertices.Add 0, 0, 0#, False, True, True, True, True

    grfThis.Properties("LimitVertices") = 4
    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis1 As Object)
        'Setup error handler
        On Error GoTo Failed
Dim grfThis As Graphic
        Set grfThis = grfThis1
        grfThis.Properties("PenStyle") = "CONTINUOUS"
        'Set up lock (prevent recursion)
        Dim LockCount&
        LockCount& = grfThis.RegenLock

        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
            grfThis.Graphics.Clear gfCosmetic

Dim Diam%, Str1$, Str2$, Str3$, d#, FontSize#
Dim Gr As Graphic

            Diam = grfThis.Properties("Diam")
            Str1 = grfThis.Properties("TagAreaSize")
            Str2 = grfThis.Properties("DatumLetter")
            Str3 = grfThis.Properties("TargetNumber")
            d = grfThis.Properties("SymbolSize")
            FontSize = grfThis.Properties("FontSize")

            'Add child Graphics
Dim Salp#, Calp#, L#
Dim X0#, Y0#, X1#, Y1#
            With grfThis.Vertices
                X0 = .Item(0).X
                Y0 = .Item(0).Y
                X1 = .Item(1).X
                Y1 = .Item(1).Y
                L = Sqr((X1 - X0) * (X1 - X0) + (Y1 - Y0) * (Y1 - Y0))
                Salp = (Y1 - Y0) / L
                Calp = (X1 - X0) / L
            End With
Dim alp#
            If Calp = 0# Then
               If Salp > 0 Then
                   alp = Pi / 2#
                   GoTo LL
               End If
               If Salp < 0 Then
                   alp = 3# * Pi / 2#
                   GoTo LL
               End If
            End If

            If Salp >= 0# And Calp > 0# Then
               alp = Atn(Abs(Salp / Calp))
            End If
            If Salp >= 0# And Calp < 0# Then
               alp = Pi - Atn(Abs(Salp / Calp))
            End If
            If Salp <= 0# And Calp < 0# Then
               alp = Pi + Atn(Abs(Salp / Calp))
            End If
            If Salp <= 0# And Calp > 0# Then
               alp = 2# * Pi - Atn(Abs(Salp / Calp))
            End If
LL:
            If alp > 6.28 Then alp = 0#
            If alp < 0.01 Then alp = 0#

            Salp = Sin(alp)
            Calp = Cos(alp)
            X1 = X0 + d / 2 * Cos(alp)
            Y1 = Y0 + d / 2 * Sin(alp)
            grfThis.Vertices(1).X = X1
            grfThis.Vertices(1).Y = Y1

     ' Add Cosmetic
        Set Gr = grfThis.Graphics.AddCircleCenterAndPoint(0, 0, 0, 0 + d / 2, 0, 0)
            Gr.Cosmetic = True
            Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
            Gr.MoveRelative X0, Y0, 0
        Set Gr = grfThis.Graphics.AddLineSingle(-d / 2, 0, 0, 0 + d / 2, 0, 0)
            Gr.Cosmetic = True
            Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
            Gr.MoveRelative X0, Y0, 0
Dim GrGroup As Graphic
Dim Gr1 As Graphic, Gr2 As Graphic
Dim BBox As BoundingBox
Dim xmax1#, ymax1#, xmin1#, ymin1#
Dim xmax2#, ymax2#, xmin2#, ymin2#
Dim xc#, yc#
Dim x2#, y2#, x3#, y3#
Dim xx0#, yy0#, xx1#, yy1#, xx2#, yy2#
        With grfThis.Vertices
            x2 = .Item(2).X
            y2 = .Item(2).Y
            x3 = .Item(3).X
            y3 = .Item(3).Y
        End With
        'Diameter an top

Dim hSym#
        hSym = FontSize

        If Diam > 0 Or Str1 <> "" Then
            Set GrGroup = grfThis.Graphics.Add(11)
            GrGroup.Cosmetic = True
            xmax1 = 0
            If Diam > 0 Then
                Set Gr1 = GrGroup.Graphics.AddText(Chr(110), 0, 0.7 * hSym, 0, 0.7 * hSym)
                    Gr1.Cosmetic = True
                Gr1.Properties("TextFont") = "gdt.shx"
                Gr1.Properties("TextStyle") = 0

                xmax1 = Gr1.CalcBoundingBox.Max.X
                xmin1 = Gr1.CalcBoundingBox.Min.X
            End If
            xmax2 = xmax1
            If Str1 <> "" Then
                Set Gr2 = GrGroup.Graphics.AddText(Str1, xmax1, hSym, 0, hSym)
                    Gr2.Cosmetic = True
                xmax2 = Gr2.CalcBoundingBox.Max.X
                xmin2 = Gr2.CalcBoundingBox.Min.X
            End If
            If Sqr((x2 - X0) * (x2 - X0) + (y2 - Y0) * (y2 - Y0)) < 0.6 * d Then
                GrGroup.MoveRelative -(xmax2 - xmin1) / 2, 0, 0
                GrGroup.RotateAxis alp, 0, 0, 1, 0, 0, 0
                GrGroup.MoveRelative X0, Y0, 0
                grfThis.Vertices(2).X = X0 + d / 4 * Cos(alp + Pi / 2)
                grfThis.Vertices(2).Y = Y0 + d / 4 * Sin(alp + Pi / 2)
            Else
                xmax1 = GrGroup.CalcBoundingBox.Max.X
                ymax1 = GrGroup.CalcBoundingBox.Max.Y
                xmin1 = GrGroup.CalcBoundingBox.Min.X
                ymin1 = GrGroup.CalcBoundingBox.Min.Y
                xc = (xmax1 + xmin1) / 2
                yc = (ymax1 + ymin1) / 2
                GrGroup.MoveRelative x2 - xc, y2 - yc, 0
                Set Gr = grfThis.Graphics.Add(11)
                    Gr.Cosmetic = True
                If x2 > X0 Then
                    xx0 = X0 + d / 4 * Cos(alp + Pi / 2)
                    yy0 = Y0 + d / 4 * Sin(alp + Pi / 2)
                    xx1 = x2 - 1.6 * (xmax1 - xmin1) / 2
                    yy1 = y2
                    xx2 = x2 - (xmax1 - xmin1) / 2
                    yy2 = y2
                Else
                    xx0 = X0 + d / 4 * Cos(alp + Pi / 2)
                    yy0 = Y0 + d / 4 * Sin(alp + Pi / 2)
                    xx1 = x2 + 1.6 * (xmax1 - xmin1) / 2
                    yy1 = y2
                    xx2 = x2 + (xmax1 - xmin1) / 2
                    yy2 = y2
                End If
                With Gr.Vertices
                    .Add xx0, yy0, 0
                    .Add xx1, yy1, 0
                    .Add xx2, yy2, 0
                End With

                Set Gr = grfThis.Graphics.AddCircleCenterAndPoint(xx0, yy0, 0, xx0 + d / 20, yy0, 0)
                    Gr.Cosmetic = True
                    Gr.Properties("BrushStyle") = "Solid"
            End If
        End If

    'Bottom
Dim Gr3 As Graphic, Gr4 As Graphic
        If Str2 <> "" Or Str3 <> "" Then
            Set GrGroup = grfThis.Graphics.Add(11)
            GrGroup.Cosmetic = True
            xmax1 = 0
            If Str2 <> "" Then
                Set Gr3 = GrGroup.Graphics.AddText(Str2, 0, 0.15 * hSym, 0, hSym)
                    Gr3.Cosmetic = True
                xmax1 = Gr3.CalcBoundingBox.Max.X
                ymax1 = Gr3.CalcBoundingBox.Max.Y
                xmin1 = Gr3.CalcBoundingBox.Min.X
                ymin1 = Gr3.CalcBoundingBox.Min.Y
            End If
            xmax2 = xmax1
            If Str3 <> "" Then
                Set Gr4 = GrGroup.Graphics.AddText(Str3, xmax1, 0.15 * hSym, 0, hSym)
                    Gr4.Cosmetic = True
                xmax2 = Gr4.CalcBoundingBox.Max.X
                ymax2 = Gr4.CalcBoundingBox.Max.Y
                xmin2 = Gr4.CalcBoundingBox.Min.X
                ymin2 = Gr4.CalcBoundingBox.Min.Y
            End If
            If Sqr((x3 - X0) * (x3 - X0) + (y3 - Y0) * (y3 - Y0)) < 0.6 * d Then
                GrGroup.MoveRelative -(xmax2 - xmin1) / 2, 0, 0
                GrGroup.RotateAxis alp, 0, 0, 1, 0, 0, 0
                GrGroup.MoveRelative X0, Y0, 0
                grfThis.Vertices(3).X = X0 + d / 4 * Cos(alp + 3 * Pi / 2)
                grfThis.Vertices(3).Y = Y0 + d / 4 * Sin(alp + 3 * Pi / 2)
            Else
                xmax1 = GrGroup.CalcBoundingBox.Max.X
                ymax1 = GrGroup.CalcBoundingBox.Max.Y
                xmin1 = GrGroup.CalcBoundingBox.Min.X
                ymin1 = GrGroup.CalcBoundingBox.Min.Y
                xc = (xmax1 + xmin1) / 2
                yc = (ymax1 + ymin1) / 2
                GrGroup.MoveRelative x3 - xc, y3 - yc, 0
                Set Gr = grfThis.Graphics.Add(11)
                    Gr.Cosmetic = True
                If x3 > X0 Then
                    xx0 = X0 + d / 4 * Cos(alp + 3 * Pi / 2)
                    yy0 = Y0 + d / 4 * Sin(alp + 3 * Pi / 2)
                    xx1 = x3 - 1.6 * (xmax1 - xmin1) / 2
                    yy1 = y3
                    xx2 = x3 - (xmax1 - xmin1) / 2
                    yy2 = y3
                Else
                    xx0 = X0 + d / 4 * Cos(alp + 3 * Pi / 2)
                    yy0 = Y0 + d / 4 * Sin(alp + 3 * Pi / 2)
                    xx1 = x3 + 1.6 * (xmax1 - xmin1) / 2
                    yy1 = y3
                    xx2 = x3 + (xmax1 - xmin1) / 2
                    yy2 = y3
                End If
                With Gr.Vertices
                    .Add xx0, yy0, 0
                    .Add xx1, yy1, 0
                    .Add xx2, yy2, 0
                End With

                Set Gr = grfThis.Graphics.AddCircleCenterAndPoint(xx0, yy0, 0, xx0 + d / 20, yy0, 0)
                    Gr.Cosmetic = True
                    Gr.Properties("BrushStyle") = "Solid"
            End If

'            If Str2 <> "" Then
'                Gr3.MoveRelative -(xmax2 - xmin1) / 2, 0, 0
'                Gr3.RotateAxis alp, 0, 0, 1, 0, 0, 0
'                Gr3.MoveRelative X0, Y0, 0
'            End If
'            If Str3 <> "" Then
'                Gr4.MoveRelative -(xmax2 + xmin1) / 2, 0, 0
'                Gr4.RotateAxis alp, 0, 0, 1, 0, 0, 0
'                Gr4.MoveRelative X0, Y0, 0
'            End If
        End If

    End If

    grfThis.RegenUnlock

        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:

        If Err.Number <> 0 Then
            MsgBox "Regen error: " & Err.Description
        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function


Examples - Datum Target Regen - DatumTarg.frm

DatumTarg.frm

Datum Target Regen Example

VERSION 5.00
Begin VB.Form frmSample
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Datum Target Symbol"
   ClientHeight    =   3936
   ClientLeft      =   6420
   ClientTop       =   2904
   ClientWidth     =   5244
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3936
   ScaleWidth      =   5244
   Begin VB.TextBox Text4
      Height          =   288
      Left            =   3240
      TabIndex        =   10
      Text            =   "Text4"
      Top             =   3360
      Width           =   972
   End
   Begin VB.TextBox Text3
      Height          =   288
      Left            =   2040
      TabIndex        =   7
      Text            =   "Text3"
      Top             =   1560
      Width           =   612
   End
   Begin VB.TextBox Text2
      Height          =   288
      Left            =   2040
      TabIndex        =   5
      Text            =   "Text2"
      Top             =   1080
      Width           =   612
   End
   Begin VB.TextBox Text1
      Height          =   372
      Left            =   840
      TabIndex        =   4
      Top             =   480
      Width           =   492
   End
   Begin VB.TextBox Text5
      Height          =   285
      Left            =   1800
      TabIndex        =   0
      Text            =   "0.25"
      ToolTipText     =   "Letter Height"
      Top             =   3360
      Width           =   975
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   240
      TabIndex        =   1
      Top             =   3000
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   240
      TabIndex        =   3
      Top             =   3480
      Width           =   1215
   End
   Begin VB.Image Image2
      BorderStyle     =   1  'Fixed Single
      Height          =   312
      Left            =   360
      Picture         =   "DatumTarg.frx":0000
      Top             =   480
      Width           =   312
   End
   Begin VB.Label Label5
      Caption         =   "Symbol Size"
      Height          =   252
      Left            =   3240
      TabIndex        =   11
      Top             =   3120
      Width           =   972
   End
   Begin VB.Image Image1
      BorderStyle     =   1  'Fixed Single
      Height          =   336
      Left            =   360
      Picture         =   "DatumTarg.frx":01A2
      Top             =   480
      Width           =   336
   End
   Begin VB.Label Label4
      Caption         =   "Target Area Size"
      Height          =   252
      Left            =   360
      TabIndex        =   9
      Top             =   120
      Width           =   1332
   End
   Begin VB.Label Label3
      Caption         =   "Target Number"
      Height          =   252
      Left            =   240
      TabIndex        =   8
      Top             =   1560
      Width           =   1692
   End
   Begin VB.Label Label2
      Caption         =   "Datum Identifying Letter"
      Height          =   252
      Left            =   240
      TabIndex        =   6
      Top             =   1080
      Width           =   1692
   End
   Begin VB.Shape Shape2
      BorderColor     =   &H000000FF&
      Height          =   852
      Left            =   1680
      Top             =   3000
      Width           =   1212
   End
   Begin VB.Label Label1
      Caption         =   "Font Height"
      Height          =   252
      Left            =   1800
      TabIndex        =   2
      Top             =   3120
      Width           =   972
   End
End
Attribute VB_Name = "frmSample"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean
Private Im00%, Im10%
Private Str10$, Str20$, Str30$, Str40$, Str50$
Private LetterHeight0$
' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    Call EscClick
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Me.Hide
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub EscClick()
    Me.Hide
End Sub

Private Sub Form_Load()
'MsgBox ("imdiam" & CStr(ImDiam))
    If ImDiam = 0 Then
        Image1.Enabled = False
        Image1.Visible = False
        Image2.Enabled = True
        Image2.Visible = True
    Else
        Image2.Enabled = False
        Image2.Visible = False
        Image1.Enabled = True
        Image1.Visible = True
    End If

End Sub

Private Sub Image1_Click()
    Image1.Enabled = False
    Image1.Visible = False
    Image2.Enabled = True
    Image2.Visible = True
    ImDiam = 0
End Sub

Private Sub Image2_Click()
    Image2.Enabled = False
    Image2.Visible = False
    Image1.Enabled = True
    Image1.Visible = True
    ImDiam = 1
End Sub


Examples - Fastener Regen - clsFasteners.cls

clsFasteners.cls

Fastener Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Detail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2000                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idDiameter = 1
Const idLength = 2
Const idBType = 3
Const idScrewView = 4

Const idLengthOld = 5
Const idLengthThread = 6

Const idDiameterOld = 7
Const idBTypeOld = 8
Const idScrewViewOld = 9
Const idLengthThreadOld = 10

Const idX0Old = 11
Const idY0Old = 12
Const idX1Old = 13
Const idY1Old = 14
Const idX2Old = 15
Const idY2Old = 16

'Property enums
Const NUM_TYPES = 0

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 16
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private PColor As Long
Private BColor As Long

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "Fasteners"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{FDB6F1C3-9631-11d1-A40A-0000B465872B}"

End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)

    Names(0) = "DiameterB"
    Types(0) = typeDouble
    IDs(0) = idDiameter
    Defaults(0) = 1#

    Names(1) = "LengthB"
    Types(1) = typeDouble
    IDs(1) = idLength
    Defaults(1) = 3#

    Names(2) = "BType"
    Types(2) = typeString
    IDs(2) = idBType
    Defaults(2) = "HexBolt"

    Names(3) = "ScrewView"
    Types(3) = typeString
    IDs(3) = idScrewView
    Defaults(3) = "FrontSection"

    Names(4) = "LengthOldB"
    Types(4) = typeDouble
    IDs(4) = idLengthOld
    Defaults(4) = 3#

    Names(5) = "LengthThreadB"
    Types(5) = typeDouble
    IDs(5) = idLengthThread
    Defaults(5) = 1.5

    Names(6) = "DiameterOldB"
    Types(6) = typeDouble
    IDs(6) = idDiameterOld
    Defaults(6) = 1#

    Names(7) = "BTypeOld"
    Types(7) = typeString
    IDs(7) = idBTypeOld
    Defaults(7) = "HexBolt"

    Names(8) = "ScrewViewOld"
    Types(8) = typeString
    IDs(8) = idScrewViewOld
    Defaults(8) = "FrontSection"

    Names(9) = "LengthThreadOldB"
    Types(9) = typeDouble
    IDs(9) = idLengthThreadOld
    Defaults(9) = 1.5

    Names(10) = "X0OldB"
    Types(10) = typeDouble
    IDs(10) = idX0Old
    Defaults(10) = 0#

    Names(11) = "Y0OldB"
    Types(11) = typeDouble
    IDs(11) = idY0Old
    Defaults(11) = 0#

    Names(12) = "X1OldB"
    Types(12) = typeDouble
    IDs(12) = idX1Old
    Defaults(12) = 3#

    Names(13) = "Y1OldB"
    Types(13) = typeDouble
    IDs(13) = idY1Old
    Defaults(13) = 0#

    Names(14) = "X2OldB"
    Types(14) = typeDouble
    IDs(14) = idX2Old
    Defaults(14) = 1.5

    Names(15) = "Y2OldB"
    Types(15) = typeDouble
    IDs(15) = idY2Old
    Defaults(15) = 0#

   GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmFasteners
    Names(0) = frmFasteners.Caption
    Unload frmFasteners

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
        GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed
        Dim Diameter#, Length#, LengthThread#
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmFasteners
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next
                'When the property page is closed, transfer the numeric
                'Diameter value from the TextBox to the Graphic
                'Get the value as a double-precision number
                Diameter# = CDbl(.txtdd.Text)
                Length# = CDbl(.txtLen.Text)
                LengthThread# = CDbl(.txtThread.Text)
                TypeB = .List1.Text
                ViewB = .List2.Text
                'Make sure it's between 0 and 100
                If Diameter# < 0# Then Diameter# = 1#
                If Diameter# > 3# Then Diameter# = 3#
                If LengthThread > Length Then LengthThread = Length
                'Set the roundness property value in the Graphic
                Graphic.Properties("DiameterB") = Diameter#
                Graphic.Properties("LengthB") = Length#
                Graphic.Properties("LengthThreadB") = LengthThread#
                Graphic.Properties("BType") = TypeB
                Graphic.Properties("ScrewView") = ViewB
            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
                Diameter# = Graphic.Properties("DiameterB")
                Length# = Graphic.Properties("LengthB")
                LengthThread = Graphic.Properties("LengthThreadB")
                TypeB = Graphic.Properties("BType")
                ViewB = Graphic.Properties("ScrewView")
            Load frmFasteners
            With frmFasteners

                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                'roundness value from the Graphic to the TextBox
                'Get the roundness property value from the Graphic
                'Set the TextBox control's text
                .txtdd.Text = Diameter#
                .txtLen = Length#
                .txtThread.Text = LengthThread#
NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmFasteners
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmFasteners
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis1 As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If
Dim grfThis As Graphic
    Set grfThis = grfThis1
    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "first point of axis"
    grfThis.Vertices.Add 0#, 0, 0#, False, True, True, True, True, False

    'Second Vertex is "Second point of axis"
    grfThis.Vertices.Add 3#, 0, 0#, False, True, True, True, True, False

    'Third Vertex is "Point on theard"
    grfThis.Vertices.Add 1.5, 0, 0#, False, True, True, True, True, False

    grfThis.Properties("PenColor") = RGB(0, 0, 0)
    grfThis.Properties("BrushColor") = RGB(255, 255, 255)
'    grfThis.Properties("BrushStyle") = "Solid"

    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis1 As Object)
        'Setup error handler
        On Error GoTo Failed
Dim grfThis As Graphic
        Set grfThis = grfThis1
        PColor = grfThis.Properties("PenColor")
'        BColor = grfThis.Properties("BrushColor")
''AALB problem with load old files
' AALB try to fix bug with reading files from TC v6.5 (problem is that some sdk regens
' has Type = 7(Group, must be GRAPHIc (11))
On Error Resume Next
Err.Clear
        BColor = grfThis.Properties("BrushColor")
        If Err.Number <> 0 Then
            BColor = RGB(255, 255, 255)
            Err.Clear
        End If

        'Set up lock (prevent recursion)
Dim LockCount&
        LockCount& = grfThis.RegenLock

        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
            grfThis.Graphics.Clear gfCosmetic

Dim dd#, ddOld#
Dim TypeBOld As String, ViewBOld As String
                dd = grfThis.Properties("DiameterB")
                ddOld = grfThis.Properties("DiameterOldB")

                TypeB = grfThis.Properties("BType")
                TypeBOld = grfThis.Properties("BTypeOld")

                ViewB = grfThis.Properties("ScrewView")
                ViewBOld = grfThis.Properties("ScrewViewOld")
Dim x0Old#, y0Old#, x1Old#, y1Old#, x2Old#, y2Old#
                x0Old = grfThis.Properties("x0OldB")
                y0Old = grfThis.Properties("y0OldB")
                x1Old = grfThis.Properties("x1OldB")
                y1Old = grfThis.Properties("y1OldB")
'MsgBox ("x1Old=" & CStr(x1Old) & "  y1Old=" & CStr(y1Old))
                x2Old = grfThis.Properties("x2OldB")
                y2Old = grfThis.Properties("y2OldB")

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim Salp#, Calp#, L#
Dim X00#, Y00#, X01#, Y01#, X02#, Y02#
Dim LenProp#, LenOld#
        LenProp = grfThis.Properties("LengthB")
        LenOld = grfThis.Properties("LengthOldB")
Dim LenPropThread#, LenThreadOld#
Dim LThread#

        LenPropThread = grfThis.Properties("LengthThreadB")
        LThread = LenPropThread
        LenThreadOld = grfThis.Properties("LengthThreadOldB")

        With grfThis.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            X02 = .Item(2).X
            Y02 = .Item(2).Y
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
            If Abs(L) < 0.001 Then
                X00 = x0Old
                Y00 = y0Old
                X01 = x1Old
                Y01 = y1Old
                X02 = x2Old
                Y02 = y2Old
                L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
                .Item(0).X = X00
                .Item(0).Y = Y00
                .Item(1).X = X01
                .Item(1).Y = Y01
                .Item(2).X = X02
                .Item(2).Y = Y02
            End If
            Salp = (Y01 - Y00) / L
            Calp = (X01 - X00) / L
        End With

' If there are changes in Property's Page
        If Abs(dd - ddOld) > 0.001 Or Abs(LenProp - LenOld) > 0.001 Or Abs(LenPropThread - LenThreadOld) > 0.001 Or TypeB <> TypeBOld Or ViewB <> ViewBOld Then
            If ViewB = "FrontSection" And (ViewBOld = "Front" Or ViewBOld = "Top") Then
Dim Calp2#, Salp2#
                Calp2 = Calp
                Salp2 = Salp
                Calp = Salp2
                Salp = -Calp2
                X01 = X00 + LenProp * Calp
                Y01 = Y00 + LenProp * Salp
                With grfThis.Vertices
                    .Item(1).X = X01
                    .Item(1).Y = Y01
                    L = LenProp
                End With
                X02 = X01 + (X00 - X01) * LenPropThread / LenProp
                Y02 = Y01 + (Y00 - Y01) * LenPropThread / LenProp
                With grfThis.Vertices
                    .Item(2).X = X02
                    .Item(2).Y = Y02
                End With
            End If
            If Abs(LenProp - LenOld) > 0.001 And ViewB = ViewBOld Then
                X01 = X00 + LenProp * Calp
                Y01 = Y00 + LenProp * Salp
                With grfThis.Vertices
                    .Item(1).X = X01
                    .Item(1).Y = Y01
                    L = LenProp
                End With
            End If
            If Abs(LenPropThread - LenThreadOld) > 0.001 And ViewB = ViewBOld Then
                If LenPropThread > LenProp Then
                    grfThis.Properties("LengthThreadB") = CDbl(Format(LenProp, "###0.00"))
                    LenPropThread = LenProp
                    LThread = LenPropThread
                End If
                X02 = X01 + (X00 - X01) * LenPropThread / LenProp
                Y02 = Y01 + (Y00 - Y01) * LenPropThread / LenProp
                With grfThis.Vertices
                    .Item(2).X = X02
                    .Item(2).Y = Y02
                End With
            End If
            GoTo LL
        End If

' If change location of the at least one base vertex
        If Abs(X00 - x0Old) > 0.001 Or Abs(Y00 - y0Old) > 0.001 Or Abs(X01 - x1Old) > 0.001 Or Abs(Y01 - y1Old) > 0.001 Or Abs(X02 - x2Old) > 0.001 Or Abs(Y02 - y2Old) > 0.001 Then
            If ViewB = "Front" Or ViewB = "Top" Then GoTo LL
            If Abs(X00 - x0Old) > 0.001 Or Abs(Y00 - y0Old) > 0.001 Or Abs(X01 - x1Old) > 0.001 Or Abs(Y01 - y1Old) > 0.001 Then
                grfThis.Properties("LengthB") = CDbl(Format(L, "###0.00"))
                If LThread > L Then
                    LThread = L
                    grfThis.Properties("LengthThreadB") = CDbl(Format(LThread, "###0.00"))
                End If
                X02 = X01 + (X00 - X01) * LThread / L
                Y02 = Y01 + (Y00 - Y01) * LThread / L
                With grfThis.Vertices
                    .Item(2).X = X02
                    .Item(2).Y = Y02
                End With
            End If
            If Abs(X00 - x0Old) < 0.001 And Abs(Y00 - y0Old) < 0.001 And Abs(X01 - x1Old) < 0.001 And Abs(Y01 - y1Old) < 0.001 Then
                If Abs(X02 - x2Old) > 0.001 Or Abs(Y02 - y2Old) > 0.001 Then
 Dim Salp1#, Calp1#
                    Salp1 = (Y00 - Y01) / L
                    Calp1 = (X00 - X01) / L
                    LThread = (Y02 - Y01) * Salp1 + (X02 - X01) * Calp1
                    If LThread > L Then LThread = L
                    If LThread < 0 Then LThread = 0#
                    grfThis.Properties("LengthThreadB") = CDbl(Format(LThread, "###0.00"))
                    X02 = X01 + (X00 - X01) * LThread / L
                    Y02 = Y01 + (Y00 - Y01) * LThread / L
                    With grfThis.Vertices
                        .Item(2).X = X02
                        .Item(2).Y = Y02
                    End With
                End If
            End If
        End If
LL:
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
            If TypeB = "HexBolt" Then Call HexBolt(grfThis, dd, L, Salp, Calp, ViewB, ViewBOld, LThread)
            If TypeB = "SlottedBolt" Then Call SlottedBolt(grfThis, dd, L, Salp, Calp, ViewB, ViewBOld, LThread)
            If TypeB = "RHBolt" Then Call RHBolt(grfThis, dd, L, Salp, Calp, ViewB, ViewBOld, LThread)
            If TypeB = "THeadBolt" Then Call THeadBolt(grfThis, dd, L, Salp, Calp, ViewB, ViewBOld, LThread)
            If TypeB = "SquareBolt" Then Call SquareBolt(grfThis, dd, L, Salp, Calp, ViewB, ViewBOld, LThread)
            If TypeB = "RHSNBolt" Then Call RHSNBolt(grfThis, dd, L, Salp, Calp, ViewB, ViewBOld, LThread)
            If TypeB = "HexFlScrew" Then Call HexFlScrew(grfThis, dd, L, Salp, Calp, ViewB, ViewBOld, LThread)
            If TypeB = "SPHScrew" Then Call SPHScrew(grfThis, dd, L, Salp, Calp, ViewB, ViewBOld, LThread)
            If TypeB = "SOCHScrew" Then Call SOCHScrew(grfThis, dd, L, Salp, Calp, ViewB, ViewBOld, LThread)
            If TypeB = "SFHCScrew" Then Call SFHCScrew(grfThis, dd, L, Salp, Calp, ViewB, ViewBOld, LThread)
            If TypeB = "RHCScrew" Then Call RHCScrew(grfThis, dd, L, Salp, Calp, ViewB, ViewBOld, LThread)
            'Add visible child Graphics
        End If
        grfThis.Properties("DiameterOldB") = grfThis.Properties("DiameterB")
        grfThis.Properties("LengthOldB") = grfThis.Properties("LengthB")
        grfThis.Properties("LengthThreadOldB") = grfThis.Properties("LengthThreadB")
        grfThis.Properties("BTypeOld") = TypeB
        grfThis.Properties("ScrewViewOld") = ViewB
        grfThis.Properties("x0OldB") = X00
        grfThis.Properties("y0OldB") = Y00
'MsgBox ("x01=" & CStr(X01) & " y01=" & CStr(Y01))
        grfThis.Properties("x1OldB") = X01
        grfThis.Properties("y1OldB") = Y01
        grfThis.Properties("x2OldB") = X02
        grfThis.Properties("y2OldB") = Y02

        grfThis.RegenUnlock
        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:

'        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
'        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function
Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function

Private Sub SlottedBolt(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)

Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
        End With
Dim D#, H#, T#, J#, del#, E#, F#
        D = 1.875 * dd
        H = 0.494 * dd
        T = 0.24 * dd
        J = 0.19 * dd
        del = 0.1 * dd

Dim X0(16)
Dim Y0(16)
Dim X(16)
Dim Y(16)

        X0(1) = H
        Y0(1) = dd / 2#

        X0(2) = X0(1)
        Y0(2) = -Y0(1)

        X0(3) = L - del
        Y0(3) = dd / 2#

        X0(4) = X0(3)
        Y0(4) = -Y0(3)

        X0(5) = L
        Y0(5) = dd / 2# - del

        X0(6) = X0(5)
        Y0(6) = -Y0(5)

        X0(7) = 0
        Y0(7) = D / 2#

        X0(8) = X0(7)
        Y0(8) = -Y0(7)

        X0(9) = 0
        Y0(9) = J / 2#

        X0(10) = X0(9)
        Y0(10) = -Y0(9)

        X0(11) = T
        Y0(11) = Y0(9)

        X0(12) = X0(11)
        Y0(12) = -Y0(11)
    '-------------------------------
        If LThread > 0 Then
            X0(13) = X0(5) - LThread
        Else
            X0(13) = X0(5) - del
        End If
        Y0(13) = dd / 2#

        X0(14) = X0(13)
        Y0(14) = -Y0(13)

        X0(15) = X0(13)
        Y0(15) = Y0(13) - del

        X0(16) = X0(15)
        Y0(16) = -Y0(15)

Dim i%
        For i = 1 To 16
             X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
             Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
        Next i
Dim GrChild As Graphic
            'Add child Graphics
' ##########################################################################
' ##########################################################################
        If ScrewView = "Front" Then
           ScrewView = "FrontSection"
            Gr.Properties("ScrewView") = ScrewView
        End If
        If ScrewView = "FrontSection" Then
            Gr.Vertices.Item(2).Editable = True
            Gr.Vertices.Item(2).Selectable = True
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, True, True, False, False, False, False
                .Add X(12), Y(12), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, False, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

        'Threading
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(13), Y(13), 0, True, True, False, False, False, False
                .Add X(14), Y(14), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(15), Y(15), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(16), Y(16), 0, False, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Properties("PenColor") = PColor
       End If

' ##########################################################################
' ##########################################################################
        If ScrewView = "Top" Then

' View Top
Dim R1#
            R1 = D / 2 - dd / 2 * T / H

            X0(1) = Sqr(D / 2# * D / 2# - J / 2# * J / 2#)
            Y0(1) = J / 2#

            X0(2) = X0(1)
            Y0(2) = -Y0(1)

            X0(3) = Sqr(R1 * R1 - J / 2# * J / 2#)
            Y0(3) = Y0(1)

            X0(4) = X0(3)
            Y0(4) = -Y0(3)

            X0(5) = R1
            Y0(5) = 0#

            X0(6) = -X0(1)
            Y0(6) = Y0(1)

            X0(7) = -X0(2)
            Y0(7) = Y0(2)

            X0(8) = -X0(3)
            Y0(8) = Y0(3)

            X0(9) = -X0(4)
            Y0(9) = Y0(4)

            X0(10) = -X0(5)
            Y0(10) = Y0(5)

            X0(11) = 0
            Y0(11) = D / 2

            X0(12) = X0(11)
            Y0(12) = -Y0(11)
            For i = 1 To 12
                X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
                Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
            Next i
'------------------------------------------------------------
Dim GrGroup As Graphic
Dim GrHatch As Graphic
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True
                .Add X(3), Y(3), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(6), Y(6), 0, True, True
                .Add X(8), Y(8), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(2), Y(2), 0, True, True
                .Add X(4), Y(4), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True
                .Add X(9), Y(9), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(3), Y(3), 0#, X(5), Y(5), 0#, X(4), Y(4), 0#)
            Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(8), Y(8), 0#, X(10), Y(10), 0#, X(9), Y(9), 0#)
            Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(1), Y(1), 0#, X(11), Y(11), 0#, X(6), Y(6), 0#)
            Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(2), Y(2), 0#, X(12), Y(12), 0#, X(7), Y(7), 0#)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True
            Set GrHatch = Nothing
            Set GrGroup = Nothing
'------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True
                .Add X(6), Y(6), 0, True, True
                .Add X(7), Y(7), 0, False, True
                .Add X(2), Y(2), 0, True, True
            End With
            GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(3), Y(3), 0#, X(5), Y(5), 0#, X(4), Y(4), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(8), Y(8), 0#, X(10), Y(10), 0#, X(9), Y(9), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(1), Y(1), 0#, X(11), Y(11), 0#, X(6), Y(6), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(2), Y(2), 0#, X(12), Y(12), 0#, X(7), Y(7), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

            Gr.Vertices.Item(1).X = X00 + D / 2 * Calp
            Gr.Vertices.Item(1).Y = Y00 + D / 2 * Salp

            Gr.Vertices.Item(2).X = Gr.Vertices.Item(1).X
            Gr.Vertices.Item(2).Y = Gr.Vertices.Item(1).Y
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False

        End If

End Sub

Private Sub HexBolt(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)

Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
        End With

Dim D#, H#, T#, J#, del#, E#, F#
        D = 1.75 * dd
        H = 0.65 * dd
        E = 0.875 * H
        F = D / 4#
        del = 0.1 * dd
Dim X0(23)
Dim Y0(23)
Dim X(23)
Dim Y(23)

       X0(1) = 0#
       Y0(1) = dd / 2#

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = L - del
       Y0(3) = dd / 2#

       X0(4) = X0(3)
       Y0(4) = -Y0(3)

       X0(5) = L
       Y0(5) = dd / 2# - del

       X0(6) = X0(5)
       Y0(6) = -Y0(5)
'-----------------------------------------------------------
       X0(7) = X0(1)
       Y0(7) = D / 2#

       X0(8) = X0(1)
       Y0(8) = -Y0(7)

       X0(9) = X0(1)
       Y0(9) = F

       X0(10) = X0(1)
       Y0(10) = -Y0(9)

       X0(11) = -E
       Y0(11) = D / 2#

       X0(12) = X0(11)
       Y0(12) = -Y0(11)

       X0(13) = -H
       Y0(13) = D / 2# - (H - E) / Sin(Pi / 3)

       X0(14) = X0(13)
       Y0(14) = -Y0(13)

       X0(15) = X0(11)
       Y0(15) = Y0(9)

       X0(16) = X0(15)
       Y0(16) = -Y0(15)

       X0(17) = -H
       Y0(17) = 3# / 2# * F

       X0(18) = X0(17)
       Y0(18) = 0#

       X0(19) = X0(17)
       Y0(19) = -Y0(17)

 '-------------------------------
        If LThread > 0 Then
            X0(20) = X0(5) - LThread
        Else
            X0(20) = X0(5) - del
        End If
       Y0(20) = dd / 2#

       X0(21) = X0(20)
       Y0(21) = -Y0(20)

       X0(22) = X0(20)
       Y0(22) = Y0(20) - del

       X0(23) = X0(22)
       Y0(23) = -Y0(22)

Dim i%
       For i = 1 To 23
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
' ##########################################################################
' ##########################################################################
        If ScrewView = "FrontSection" Then
            Gr.Vertices.Item(2).Editable = True
            Gr.Vertices.Item(2).Selectable = True

            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(12), Y(12), 0, True, True, False, False, False, False
                .Add X(14), Y(14), 0, True, True, False, False, False, False
                .Add X(13), Y(13), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
            End With
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor

            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False

                .Add X(3), Y(3), 0, False, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False

                .Add X(9), Y(9), 0, False, True, False, False, False, False
                .Add X(15), Y(15), 0, True, True, False, False, False, False

                .Add X(10), Y(10), 0, False, True, False, False, False, False
                .Add X(16), Y(16), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(11), Y(11), 0#, X(17), Y(17), 0#, X(15), Y(15), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(15), Y(15), 0#, X(18), Y(18), 0#, X(16), Y(16), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '16
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(16), Y(16), 0#, X(19), Y(19), 0#, X(12), Y(12), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(20), Y(20), 0, True, True, False, False, False, False
                .Add X(21), Y(21), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenColor") = PColor
            With GrChild.Vertices
                .Add X(22), Y(22), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(23), Y(23), 0, False, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
            End With
             GrChild.Properties("PenColor") = PColor
       End If
' ##########################################################################
' ##########################################################################
        If ScrewView = "Front" Then
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            If ScrewViewOld = "FrontSection" Then
Dim Calp2#, Salp2#
                Calp2 = Calp
                Salp2 = Salp
                Calp = -Salp2
                Salp = Calp2

            End If
                For i = 1 To 23
                    X(i) = X00 + X0(i) * Salp + Y0(i) * Calp
                    Y(i) = Y00 - X0(i) * Calp + Y0(i) * Salp
                Next i
           With GrChild.Vertices
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(12), Y(12), 0, True, True, False, False, False, False
                .Add X(14), Y(14), 0, True, True, False, False, False, False
                .Add X(13), Y(13), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
            End With
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
           With GrChild.Vertices
                .Add X(9), Y(9), 0, False, True, False, False, False, False
                .Add X(15), Y(15), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, False, True, False, False, False, False
                .Add X(16), Y(16), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(11), Y(11), 0#, X(17), Y(17), 0#, X(15), Y(15), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(15), Y(15), 0#, X(18), Y(18), 0#, X(16), Y(16), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '16
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(16), Y(16), 0#, X(19), Y(19), 0#, X(12), Y(12), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
                        Gr.Vertices.Item(1).X = X(7)
                        Gr.Vertices.Item(1).Y = Y(7)

                        Gr.Vertices.Item(2).X = X(7)
                        Gr.Vertices.Item(2).Y = Y(7)
                        Gr.Vertices.Item(2).Editable = False
                        Gr.Vertices.Item(2).Selectable = False

    '-------------------------------------------------------------
        End If
' ##########################################################################
' ##########################################################################
        If ScrewView = "Top" Then
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
' View Top
            With GrChild.Vertices
                For i = 0 To 6
                    X0(i) = D / 2 * Cos(Pi / 3 * i)
                    Y0(i) = D / 2 * Sin(Pi / 3 * i)
                    X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
                    Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
                    If i = 0 Then
                        Gr.Vertices.Item(1).X = X(i)
                        Gr.Vertices.Item(1).Y = Y(i)
                    End If
                   .Add X(i), Y(i), 0, True, True, False, False, False, False
                Next i
            End With
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor

            X(7) = X00 + D / 2 * Sin(Pi / 3)
            Y(7) = Y00
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X(7), Y(7), 0)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Gr.Vertices.Item(2).X = Gr.Vertices.Item(1).X
            Gr.Vertices.Item(2).Y = Gr.Vertices.Item(1).Y
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False

        End If

End Sub

' Round Head Bolt

Private Sub RHBolt(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)

Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
        End With

Dim D#, H#, T#, J#, del#, E#, F#
        D = 2.1 * dd
        H = 0.531 * dd
        E = 0.8 * H
        F = D / 4#
        del = 0.1 * dd
Dim X0(13)
Dim Y0(13)
Dim X(13)
Dim Y(13)

       X0(1) = 0#
       Y0(1) = dd / 2#

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = L - del
       Y0(3) = dd / 2#

       X0(4) = X0(3)
       Y0(4) = -Y0(3)

       X0(5) = L
       Y0(5) = dd / 2# - del

       X0(6) = X0(5)
       Y0(6) = -Y0(5)
'-----------------------------------------------------------
       X0(7) = X0(1)
       Y0(7) = D / 2#

       X0(8) = X0(1)
       Y0(8) = -Y0(7)

       X0(9) = X0(1) - H
       Y0(9) = 0

 '-------------------------------
        If LThread > 0 Then
            X0(10) = X0(5) - LThread
        Else
            X0(10) = X0(5) - del
        End If
       Y0(10) = dd / 2#

       X0(11) = X0(10)
       Y0(11) = -Y0(10)

       X0(12) = X0(10)
       Y0(12) = Y0(10) - del

       X0(13) = X0(12)
       Y0(13) = -Y0(12)

Dim i%
       For i = 1 To 13
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
'##################################################################
'##################################################################
        If ScrewView = "FrontSection" Then
            Gr.Vertices.Item(2).Editable = True
            Gr.Vertices.Item(2).Selectable = True
'-----------------------------------------------------------
Dim GrGroup As Graphic
Dim GrHatch As Graphic
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True
                .Add X(1), Y(1), 0, True, True
                .Add X(3), Y(3), 0, True, True
                .Add X(5), Y(5), 0, True, True
                .Add X(6), Y(6), 0, True, True
                .Add X(4), Y(4), 0, True, True
                .Add X(2), Y(2), 0, True, True
                .Add X(8), Y(8), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(7), Y(7), 0#, X(9), Y(9), 0#, X(8), Y(8), 0#)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True
            Set GrHatch = Nothing
            Set GrGroup = Nothing
'-----------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, False, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False

                .Add X(7), Y(7), 0, False, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(7), Y(7), 0#, X(9), Y(9), 0#, X(8), Y(8), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(10), Y(10), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
'Thread
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(12), Y(12), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(13), Y(13), 0, False, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
        End If
'##################################################################
'##################################################################
        If ScrewView = "Front" Then
            If ScrewViewOld = "FrontSection" Then
Dim Calp2#, Salp2#
                Calp2 = Calp
                Salp2 = Salp
                Calp = -Salp2
                Salp = Calp2

            End If
                For i = 1 To 13
                    X(i) = X00 + X0(i) * Salp + Y0(i) * Calp
                    Y(i) = Y00 - X0(i) * Calp + Y0(i) * Salp
                Next i
'-----------------------------------------------------------
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True
                .Add X(8), Y(8), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(7), Y(7), 0#, X(9), Y(9), 0#, X(8), Y(8), 0#)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True
            Set GrHatch = Nothing
            Set GrGroup = Nothing
'-----------------------------------------------------------

            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
           With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(7), Y(7), 0#, X(9), Y(9), 0#, X(8), Y(8), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

            Gr.Vertices.Item(1).X = X(7)
            Gr.Vertices.Item(1).Y = Y(7)

            Gr.Vertices.Item(2).X = X(7)
            Gr.Vertices.Item(2).Y = Y(7)
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False
    '-------------------------------------------------------------
        End If
' ##########################################################################
' ##########################################################################
        If ScrewView = "Top" Then
' View Top

            X(1) = X00 + D / 2 * Calp
            Y(1) = Y00 + D / 2 * Salp
            Gr.Vertices.Item(1).X = X(1)
            Gr.Vertices.Item(1).Y = Y(1)
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X(1), Y(1), 0)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
            Gr.Vertices.Item(2).X = Gr.Vertices.Item(1).X
            Gr.Vertices.Item(2).Y = Gr.Vertices.Item(1).Y
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False

        End If

End Sub

' T-Head Bolt

Private Sub THeadBolt(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)
Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
        End With

Dim D#, H#, del#, K#, F#
        D = 2# * dd
        H = 0.9 * dd
        F = 0.7 * H
        del = 0.1 * dd
Dim X0(19)
Dim Y0(19)
Dim X(19)
Dim Y(19)

       X0(1) = 0#
       Y0(1) = dd / 2#

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = L - del
       Y0(3) = dd / 2#

       X0(4) = X0(3)
       Y0(4) = -Y0(3)

       X0(5) = L
       Y0(5) = dd / 2# - del

       X0(6) = X0(5)
       Y0(6) = -Y0(5)
'-----------------------------------------------------------
       X0(7) = X0(1)
       Y0(7) = D / 2#

       X0(8) = X0(1)
       Y0(8) = -Y0(7)

       X0(9) = X0(1)
       Y0(9) = dd / 4#

       X0(10) = X0(1)
       Y0(10) = -Y0(9)

       X0(11) = X0(1) + dd / 4
       Y0(11) = dd / 4#

       X0(12) = X0(11)
       Y0(12) = -Y0(11)

       X0(13) = -F
       Y0(13) = D / 2#

       X0(14) = X0(13)
       Y0(14) = -Y0(13)

       X0(15) = -H
       Y0(15) = 0#

'Thread
 '-------------------------------
        If LThread > 0 Then
            X0(16) = X0(5) - LThread
        Else
            X0(16) = X0(5) - del
        End If
       Y0(16) = dd / 2#

       X0(17) = X0(16)
       Y0(17) = -Y0(16)

       X0(18) = X0(16)
       Y0(18) = Y0(16) - del

       X0(19) = X0(18)
       Y0(19) = -Y0(18)

Dim i%
       For i = 1 To 19
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
        If ScrewView = "FrontSection" Then
            Gr.Vertices.Item(2).Editable = True
            Gr.Vertices.Item(2).Selectable = True
'-----------------------------------------------------------
Dim GrGroup As Graphic
Dim GrHatch As Graphic
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(13), Y(13), 0, True, True
                .Add X(7), Y(7), 0, True, True
                .Add X(1), Y(1), 0, True, True
                .Add X(3), Y(3), 0, True, True
                .Add X(5), Y(5), 0, True, True
                .Add X(6), Y(6), 0, True, True
                .Add X(4), Y(4), 0, True, True
                .Add X(2), Y(2), 0, True, True
                .Add X(8), Y(8), 0, True, True
                .Add X(14), Y(14), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(13), Y(13), 0#, X(15), Y(15), 0#, X(14), Y(14), 0#)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True
            Set GrHatch = Nothing
            Set GrGroup = Nothing
'-----------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, False, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False

                .Add X(13), Y(13), 0, False, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, True, True, False, False, False, False

                .Add X(14), Y(14), 0, False, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

    Dim Alp#
            Alp = Angle(Salp, Calp)

            Set GrChild = Gr.Graphics.AddArcCenterAndPoint(X(11), Y(11), 0, X(9), Y(9), 0, Pi + Alp, Pi + Pi / 4 + Alp)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
             GrChild.Properties("PenColor") = PColor
           Set GrChild = Gr.Graphics.AddArcCenterAndPoint(X(12), Y(12), 0, X(10), Y(10), 0, Pi - Pi / 4 + Alp, Pi + Alp)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
          '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(13), Y(13), 0#, X(15), Y(15), 0#, X(14), Y(14), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(16), Y(16), 0, True, True, False, False, False, False
                .Add X(17), Y(17), 0, True, True, False, False, False, False
            End With
             GrChild.Properties("PenColor") = PColor
           Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(18), Y(18), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(19), Y(19), 0, False, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
            End With
             GrChild.Properties("PenColor") = PColor
       End If
'##################################################################
'##################################################################
        If ScrewView = "Front" Then
            If ScrewViewOld = "FrontSection" Then
Dim Calp2#, Salp2#
                Calp2 = Calp
                Salp2 = Salp
                Calp = -Salp2
                Salp = Calp2

            End If
                For i = 1 To 19
                    X(i) = X00 + X0(i) * Salp + Y0(i) * Calp
                    Y(i) = Y00 - X0(i) * Calp + Y0(i) * Salp
                Next i
'-----------------------------------------------------------
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(13), Y(13), 0, True, True
                .Add X(7), Y(7), 0, True, True
                .Add X(8), Y(8), 0, True, True
                .Add X(14), Y(14), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(13), Y(13), 0#, X(15), Y(15), 0#, X(14), Y(14), 0#)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True
            Set GrHatch = Nothing
            Set GrGroup = Nothing
'-----------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
           With GrChild.Vertices
                .Add X(13), Y(13), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(14), Y(14), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(13), Y(13), 0#, X(15), Y(15), 0#, X(14), Y(14), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

            Gr.Vertices.Item(1).X = X(7)
            Gr.Vertices.Item(1).Y = Y(7)

            Gr.Vertices.Item(2).X = X(7)
            Gr.Vertices.Item(2).Y = Y(7)
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False
    '-------------------------------------------------------------
        End If
' ##########################################################################
' ##########################################################################
        If ScrewView = "Top" Then
' View Top
            X0(1) = D / 2
            Y0(1) = dd / 2

            X0(2) = -D / 2
            Y0(2) = dd / 2

            X0(3) = -D / 2
            Y0(3) = -dd / 2

            X0(4) = D / 2
            Y0(4) = -dd / 2

            X0(5) = D / 2
            Y0(5) = dd / 2
           Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                For i = 1 To 5
                    X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
                    Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
                   .Add X(i), Y(i), 0, True, True, True, False, False, False
                Next i
            End With
            GrChild.Closed = True
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Gr.Vertices.Item(1).X = X00 + D / 2 * Calp
            Gr.Vertices.Item(1).Y = Y00 + D / 2 * Salp

            Gr.Vertices.Item(2).X = Gr.Vertices.Item(1).X
            Gr.Vertices.Item(2).Y = Gr.Vertices.Item(1).Y
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False

        End If

End Sub

'Square Bolt

Private Sub SquareBolt(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)

Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
        End With

Dim D#, H#, del#, E#
        D = 2.12 * dd
        H = 0.68 * dd
        E = 0.875 * H
        del = 0.1 * dd
Dim X0(20)
Dim Y0(20)
Dim X(20)
Dim Y(20)

       X0(1) = 0#
       Y0(1) = dd / 2#

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = L - del
       Y0(3) = dd / 2#

       X0(4) = X0(3)
       Y0(4) = -Y0(3)

       X0(5) = L
       Y0(5) = dd / 2# - del

       X0(6) = X0(5)
       Y0(6) = -Y0(5)
'-----------------------------------------------------------
       X0(7) = X0(1)
       Y0(7) = D / 2#

       X0(8) = X0(1)
       Y0(8) = -Y0(7)

       X0(9) = X0(1)
       Y0(9) = 0

       X0(10) = -E
       Y0(10) = D / 2#

       X0(11) = X0(10)
       Y0(11) = -Y0(10)

       X0(12) = -H
       Y0(12) = D / 2# - (H - E) / Sin(Pi / 3)

       X0(13) = X0(12)
       Y0(13) = -Y0(12)

       X0(14) = X0(10)
       Y0(14) = Y0(9)

       X0(15) = -H
       Y0(15) = dd / 2

       X0(16) = X0(15)
       Y0(16) = -Y0(15)

 '-------------------------------
        If LThread > 0 Then
            X0(17) = X0(5) - LThread
        Else
            X0(17) = X0(5) - del
        End If
       Y0(17) = dd / 2#

       X0(18) = X0(17)
       Y0(18) = -Y0(17)

       X0(19) = X0(17)
       Y0(19) = Y0(17) - del

       X0(20) = X0(19)
       Y0(20) = -Y0(19)

Dim i%
       For i = 1 To 20
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
' ##########################################################################
' ##########################################################################
        If ScrewView = "FrontSection" Then
            Gr.Vertices.Item(2).Editable = True
            Gr.Vertices.Item(2).Selectable = True
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(13), Y(13), 0, True, True, False, False, False, False
                .Add X(12), Y(12), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Closed = True
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor

            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, False, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False

                .Add X(3), Y(3), 0, False, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False

                .Add X(9), Y(9), 0, False, True, False, False, False, False
                .Add X(14), Y(14), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, X(15), Y(15), 0#, X(14), Y(14), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(14), Y(14), 0#, X(16), Y(16), 0#, X(11), Y(11), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(17), Y(17), 0, True, True, False, False, False, False
                .Add X(18), Y(18), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(19), Y(19), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(20), Y(20), 0, False, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
        End If
' ##########################################################################
' ##########################################################################
        If ScrewView = "Front" Then
            If ScrewViewOld = "FrontSection" Then
Dim Calp2#, Salp2#
                Calp2 = Calp
                Salp2 = Salp
                Calp = -Salp2
                Salp = Calp2
            End If
            For i = 1 To 20
                X(i) = X00 + X0(i) * Salp + Y0(i) * Calp
                Y(i) = Y00 - X0(i) * Calp + Y0(i) * Salp
            Next i
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, True, True, False, False, False, False
                .Add X(12), Y(12), 0, True, True, False, False, False, False
                .Add X(13), Y(13), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Closed = True
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor

            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(9), Y(9), 0, False, True, False, False, False, False
                .Add X(14), Y(14), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, X(15), Y(15), 0#, X(14), Y(14), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(14), Y(14), 0#, X(16), Y(16), 0#, X(11), Y(11), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

            Gr.Vertices.Item(1).X = X(7)
            Gr.Vertices.Item(1).Y = Y(7)

            Gr.Vertices.Item(2).X = X(7)
            Gr.Vertices.Item(2).Y = Y(7)
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False
    '-------------------------------------------------------------
        End If
' ##########################################################################
' ##########################################################################
        If ScrewView = "Top" Then
' View Top
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                For i = 0 To 4
                    X0(i) = D / 2 * Cos(Pi / 2 * i)
                    Y0(i) = D / 2 * Sin(Pi / 2 * i)
                    X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
                    Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
                    If i = 0 Then
                        Gr.Vertices.Item(1).X = X(i)
                        Gr.Vertices.Item(1).Y = Y(i)
                    End If
                   .Add X(i), Y(i), 0, True, True, False, False, False, False
                Next i
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Closed = True
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
            X(5) = X00 + D / 2 * Sin(Pi / 4)
            Y(5) = Y00
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X(5), Y(5), 0)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Gr.Vertices.Item(2).X = Gr.Vertices.Item(1).X
            Gr.Vertices.Item(2).Y = Gr.Vertices.Item(1).Y
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False
    End If
End Sub

'Round Head Square Neck Bolt

Private Sub RHSNBolt(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)

Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
        End With

Dim D#, H#, del#, P#, W#, E#
        D = 2.1 * dd
        H = 0.53 * dd
        P = 0.53 * dd
        W = 1.41 * dd
        E = P - (W - dd) / 2 * Tan(Pi / 6)
        del = 0.1 * dd
Dim X0(21)
Dim Y0(21)
Dim X(21)
Dim Y(21)

       X0(1) = 0#
       Y0(1) = W / 2#

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = X0(1) + E
       Y0(3) = Y0(1)

       X0(4) = X0(3)
       Y0(4) = -Y0(3)

       X0(5) = X0(1) + P
       Y0(5) = dd / 2

       X0(6) = X0(5)
       Y0(6) = -Y0(5)

       X0(7) = L - del
       Y0(7) = Y0(5)

       X0(8) = X0(7)
       Y0(8) = -Y0(7)

       X0(9) = L
       Y0(9) = Y0(5) - del

       X0(10) = X0(9)
       Y0(10) = -Y0(9)
'-----------------------------------------------------------
       X0(11) = X0(1)
       Y0(11) = 0#

       X0(12) = X0(1) + E
       Y0(12) = 0#

       X0(13) = X0(1)
       Y0(13) = D / 2

       X0(14) = X0(13)
       Y0(14) = -Y0(13)

       X0(15) = X0(1) - H
       Y0(15) = 0#

       X0(16) = X0(1) + P
       Y0(16) = W / 4

       X0(17) = X0(16)
       Y0(17) = -Y0(16)
 '-------------------------------
        If LThread > 0 Then
            X0(18) = X0(9) - LThread
        Else
            X0(18) = X0(9) - del
        End If
       Y0(18) = dd / 2#

       X0(19) = X0(18)
       Y0(19) = -Y0(18)

       X0(20) = X0(18)
       Y0(20) = Y0(18) - del

       X0(21) = X0(20)
       Y0(21) = -Y0(20)

Dim i%
       For i = 1 To 21
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
' ##########################################################################
' ##########################################################################
        If ScrewView = "FrontSection" Then
            Gr.Vertices.Item(2).Editable = True
            Gr.Vertices.Item(2).Selectable = True
'-----------------------------------------------------------
Dim GrGroup As Graphic
Dim GrHatch As Graphic
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(13), Y(13), 0, True
                .Add X(1), Y(1), 0, True
                .Add X(3), Y(3), 0, True
                .Add X(5), Y(5), 0, True
                .Add X(7), Y(7), 0, True
                .Add X(9), Y(9), 0, True
                .Add X(10), Y(10), 0, True
                .Add X(8), Y(8), 0, True
                .Add X(6), Y(6), 0, True
                .Add X(4), Y(4), 0, True
                .Add X(2), Y(2), 0, True
                .Add X(14), Y(14), 0, True
            End With
           Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(13), Y(13), 0#, X(15), Y(15), 0#, X(14), Y(14), 0#)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True
            Set GrHatch = Nothing
            Set GrGroup = Nothing
'-----------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, False, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, False, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(13), Y(13), 0, False, True, False, False, False, False
                .Add X(14), Y(14), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, False, True, False, False, False, False
                .Add X(12), Y(12), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(13), Y(13), 0#, X(15), Y(15), 0#, X(14), Y(14), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(3), Y(3), 0#, X(16), Y(16), 0#, X(12), Y(12), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '16
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(4), Y(4), 0#, X(17), Y(17), 0#, X(12), Y(12), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(18), Y(18), 0, True, True, False, False, False, False
                .Add X(19), Y(19), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(20), Y(20), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, True, True, False, False, False, False
                .Add X(21), Y(21), 0, False, True, False, False, False, False
                .Add X(10), Y(10), 0, True, True, False, False, False, False
            End With
             GrChild.Properties("PenColor") = PColor
       End If

'##################################################################
'##################################################################
        If ScrewView = "Front" Then
            If ScrewViewOld = "FrontSection" Then
Dim Calp2#, Salp2#
                Calp2 = Calp
                Salp2 = Salp
                Calp = -Salp2
                Salp = Calp2

            End If
            For i = 1 To 21
                X(i) = X00 + X0(i) * Salp + Y0(i) * Calp
                Y(i) = Y00 - X0(i) * Calp + Y0(i) * Salp
            Next i
'-----------------------------------------------------------
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(13), Y(13), 0, True, True
                .Add X(14), Y(14), 0, True, True
            End With
           Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(13), Y(13), 0#, X(15), Y(15), 0#, X(14), Y(14), 0#)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True
            Set GrHatch = Nothing
            Set GrGroup = Nothing
'-----------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
           With GrChild.Vertices
                .Add X(13), Y(13), 0, True, True, False, False, False, False
                .Add X(14), Y(14), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(13), Y(13), 0#, X(15), Y(15), 0#, X(14), Y(14), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

            Gr.Vertices.Item(1).X = X(13)
            Gr.Vertices.Item(1).Y = Y(13)

            Gr.Vertices.Item(2).X = X(13)
            Gr.Vertices.Item(2).Y = Y(13)
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False
    '-------------------------------------------------------------
        End If
' ##########################################################################
' ##########################################################################
        If ScrewView = "Top" Then
' View Top

            X(1) = X00 + D / 2 * Calp
            Y(1) = Y00 + D / 2 * Salp
            Gr.Vertices.Item(1).X = X(1)
            Gr.Vertices.Item(1).Y = Y(1)
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X(1), Y(1), 0)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
            Gr.Vertices.Item(2).X = Gr.Vertices.Item(1).X
            Gr.Vertices.Item(2).Y = Gr.Vertices.Item(1).Y
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False
        End If
End Sub

'Hex Flange Screw

Private Sub HexFlScrew(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)

Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
        End With

Dim D#, Dw#, Di#, C#, K1#, K#, E#, del#
        D = 1.4 * dd
        Dw = 2.08 * dd
        C = 0.15 * dd
        K1 = 0.43 * dd
        K = 0.97 * dd
        E = (K - K1) * 0.85
        Di = D * Sin(Pi / 3)
        del = 0.1 * dd
Dim X0(27)
Dim Y0(27)
Dim X(27)
Dim Y(27)

       X0(1) = 0#
       Y0(1) = dd / 2#

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = L - del
       Y0(3) = Y0(1)

       X0(4) = X0(3)
       Y0(4) = -Y0(3)

       X0(5) = L
       Y0(5) = Y0(1) - del

       X0(6) = X0(5)
       Y0(6) = -Y0(5)

       X0(7) = 0
       Y0(7) = Dw / 2

       X0(8) = X0(7)
       Y0(8) = -Y0(7)

       X0(9) = -C
       Y0(9) = Dw / 2

       X0(10) = X0(9)
       Y0(10) = -Y0(9)

       X0(11) = -K1
       Y0(11) = D / 2

       X0(12) = X0(11)
       Y0(12) = -Y0(11)

       X0(13) = -K1 - E
       Y0(13) = D / 2

       X0(14) = X0(13)
       Y0(14) = -Y0(13)

       X0(15) = -K
       Y0(15) = Di / 2

       X0(16) = X0(15)
       Y0(16) = -Y0(15)

       X0(17) = -K1
       Y0(17) = D / 4

       X0(18) = X0(17)
       Y0(18) = -Y0(17)

       X0(19) = X0(13)
       Y0(19) = Y0(17)

       X0(20) = X0(19)
       Y0(20) = -Y0(19)

       X0(21) = -K
       Y0(21) = 3 / 8 * D

       X0(22) = X0(21)
       Y0(22) = -Y0(21)

       X0(23) = -K
       Y0(23) = 0

 '-------------------------------
        If LThread > 0 Then
            X0(24) = X0(5) - LThread
        Else
            X0(24) = X0(5) - del
        End If
       Y0(24) = dd / 2#

       X0(25) = X0(24)
       Y0(25) = -Y0(24)

       X0(26) = X0(24)
       Y0(26) = Y0(24) - del

       X0(27) = X0(26)
       Y0(27) = -Y0(26)

Dim i%
       For i = 1 To 27
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
'################################################################
'################################################################
        If ScrewView = "FrontSection" Then
            Gr.Vertices.Item(2).Editable = True
            Gr.Vertices.Item(2).Selectable = True
'------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, True, True, False, False, False, False
                .Add X(12), Y(12), 0, True, True, False, False, False, False
                .Add X(14), Y(14), 0, True, True, False, False, False, False
                .Add X(16), Y(16), 0, True, True, False, False, False, False
                .Add X(15), Y(15), 0, True, True, False, False, False, False
                .Add X(13), Y(13), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Closed = True
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
'------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False

                .Add X(3), Y(3), 0, False, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False

                .Add X(17), Y(17), 0, False, True, False, False, False, False
                .Add X(19), Y(19), 0, True, True, False, False, False, False

                .Add X(18), Y(18), 0, False, True, False, False, False, False
                .Add X(20), Y(20), 0, True, True, False, False, False, False

                .Add X(11), Y(11), 0, False, True, False, False, False, False
                .Add X(12), Y(12), 0, True, True, False, False, False, False

                .Add X(9), Y(9), 0, False, True, False, False, False, False
                .Add X(10), Y(10), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(13), Y(13), 0#, X(21), Y(21), 0#, X(19), Y(19), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(14), Y(14), 0#, X(22), Y(22), 0#, X(20), Y(20), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '16
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(19), Y(19), 0#, X(23), Y(23), 0#, X(20), Y(20), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(24), Y(24), 0, True, True, False, False, False, False
                .Add X(25), Y(25), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(26), Y(26), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(27), Y(27), 0, False, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
        End If

'#############################################################
'#############################################################
        If ScrewView = "Front" Then
            If ScrewViewOld = "FrontSection" Then
Dim Calp2#, Salp2#
                Calp2 = Calp
                Salp2 = Salp
                Calp = -Salp2
                Salp = Calp2

            End If
            For i = 1 To 27
                X(i) = X00 + X0(i) * Salp + Y0(i) * Calp
                Y(i) = Y00 - X0(i) * Calp + Y0(i) * Salp
            Next i
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, True, True, False, False, False, False
                .Add X(12), Y(12), 0, True, True, False, False, False, False
                .Add X(14), Y(14), 0, True, True, False, False, False, False
                .Add X(16), Y(16), 0, True, True, False, False, False, False
                .Add X(15), Y(15), 0, True, True, False, False, False, False
                .Add X(13), Y(13), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Closed = True
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor

            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(17), Y(17), 0, False, True, False, False, False, False
                .Add X(19), Y(19), 0, True, True, False, False, False, False

                .Add X(18), Y(18), 0, False, True, False, False, False, False
                .Add X(20), Y(20), 0, True, True, False, False, False, False

                .Add X(11), Y(11), 0, False, True, False, False, False, False
                .Add X(12), Y(12), 0, True, True, False, False, False, False

                .Add X(9), Y(9), 0, False, True, False, False, False, False
                .Add X(10), Y(10), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(13), Y(13), 0#, X(21), Y(21), 0#, X(19), Y(19), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(14), Y(14), 0#, X(22), Y(22), 0#, X(20), Y(20), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '16
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(19), Y(19), 0#, X(23), Y(23), 0#, X(20), Y(20), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

            Gr.Vertices.Item(1).X = X(7)
            Gr.Vertices.Item(1).Y = Y(7)

            Gr.Vertices.Item(2).X = X(7)
            Gr.Vertices.Item(2).Y = Y(7)
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False
        End If

' ##########################################################################
' ##########################################################################
        If ScrewView = "Top" Then
' View Top
            X(8) = X00 + Dw / 2
            Y(8) = Y00
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X(8), Y(8), 0)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor

            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                For i = 0 To 6
                    X0(i) = D / 2 * Cos(Pi / 3 * i)
                    Y0(i) = D / 2 * Sin(Pi / 3 * i)
                    X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
                    Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
                    If i = 0 Then
                        Gr.Vertices.Item(1).X = X(i)
                        Gr.Vertices.Item(1).Y = Y(i)
                    End If
                   .Add X(i), Y(i), 0, True, True, False, False, False, False
                Next i
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            X(7) = X00 + D / 2 * Sin(Pi / 3)
            Y(7) = Y00
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X(7), Y(7), 0)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Gr.Vertices.Item(2).X = Gr.Vertices.Item(1).X
            Gr.Vertices.Item(2).Y = Gr.Vertices.Item(1).Y
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False

        End If

End Sub

'Slotted Pan Head Screw

Private Sub SPHScrew(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)

Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
        End With

Dim D#, H#, del#, J#, T#, R#
        D = 2# * dd
        H = 0.54 * dd
        R = 0.35 * dd
        J = 0.2 * dd
        T = 0.3 * dd
        del = 0.1 * dd
Dim X0(22)
Dim Y0(22)
Dim X(22)
Dim Y(22)

       X0(1) = 0#
       Y0(1) = dd / 2#

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = L - del
       Y0(3) = Y0(1)

       X0(4) = X0(3)
       Y0(4) = -Y0(3)

       X0(5) = L
       Y0(5) = dd / 2 - del

       X0(6) = X0(5)
       Y0(6) = -Y0(5)

       X0(7) = 0
       Y0(7) = D / 2

       X0(8) = X0(7)
       Y0(8) = -Y0(7)

       X0(9) = -H + R
       Y0(9) = Y0(7)

       X0(10) = X0(9)
       Y0(10) = -Y0(9)

       X0(11) = -H
       Y0(11) = Y0(9) - R

       X0(12) = X0(11)
       Y0(12) = -Y0(11)

       X0(13) = -H
       Y0(13) = J / 2

       X0(14) = X0(13)
       Y0(14) = -Y0(13)

       X0(15) = X0(13) + T
       Y0(15) = Y0(13)

       X0(16) = X0(15)
       Y0(16) = -Y0(15)

       X0(17) = X0(13) + R
       Y0(17) = Y0(11)

       X0(18) = X0(17)
       Y0(18) = -Y0(17)

 '-------------------------------
        If LThread > 0 Then
            X0(19) = X0(5) - LThread
        Else
            X0(19) = X0(5) - del
        End If
       Y0(19) = dd / 2#

       X0(20) = X0(19)
       Y0(20) = -Y0(19)

       X0(21) = X0(19)
       Y0(21) = Y0(19) - del

       X0(22) = X0(21)
       Y0(22) = -Y0(21)

Dim i%
       For i = 1 To 22
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
'#############################################################
'#############################################################
        If ScrewView = "FrontSection" Then
            Gr.Vertices.Item(2).Editable = True
            Gr.Vertices.Item(2).Selectable = True
Dim Alp#
            Alp = Angle(Salp, Calp)
'-----------------------------------------------------------
Dim GrGroup As Graphic
Dim GrHatch As Graphic
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(9), Y(9), 0, True, True
                .Add X(7), Y(7), 0, True, True
                .Add X(1), Y(1), 0, True, True
                .Add X(3), Y(3), 0, True, True
                .Add X(5), Y(5), 0, True, True
                .Add X(6), Y(6), 0, True, True
                .Add X(4), Y(4), 0, True, True
                .Add X(2), Y(2), 0, True, True
                .Add X(8), Y(8), 0, True, True
                .Add X(10), Y(10), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(11), Y(11), 0, True, True
                .Add X(13), Y(13), 0, True, True
                .Add X(15), Y(15), 0, True, True
                .Add X(16), Y(16), 0, True, True
                .Add X(14), Y(14), 0, True, True
                .Add X(12), Y(12), 0, True, True
            End With
           Set GrChild = GrGroup.Graphics.AddArcCenterAndPoint(X(17), Y(17), 0#, X(11), Y(11), 0#, Pi / 2 + Alp, Pi + Alp)
           Set GrChild = GrGroup.Graphics.AddArcCenterAndPoint(X(18), Y(18), 0#, X(12), Y(12), 0#, Pi + Alp, 3 * Pi / 2 + Alp)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True
            Set GrHatch = Nothing
            Set GrGroup = Nothing
'-----------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, True, True, False, False, False, False
                .Add X(12), Y(12), 0, False, True, False, False, False, False
                .Add X(14), Y(14), 0, True, True, False, False, False, False
                .Add X(16), Y(16), 0, True, True, False, False, False, False
                .Add X(15), Y(15), 0, True, True, False, False, False, False
                .Add X(13), Y(13), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, False, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, False, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False

            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '14
           Set GrChild = Gr.Graphics.AddArcCenterAndPoint(X(17), Y(17), 0#, X(11), Y(11), 0#, Pi / 2 + Alp, Pi + Alp)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcCenterAndPoint(X(18), Y(18), 0#, X(12), Y(12), 0#, Pi + Alp, 3 * Pi / 2 + Alp)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(19), Y(19), 0, True, True, False, False, False, False
                .Add X(20), Y(20), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(21), Y(21), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(22), Y(22), 0, False, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
        End If
'#############################################################
'#############################################################
        If ScrewView = "Front" Then
            If ScrewViewOld = "FrontSection" Then
Dim Calp2#, Salp2#
                Calp2 = Calp
                Salp2 = Salp
                Calp = -Salp2
                Salp = Calp2
            End If
'            Alp = Angle(Salp, Calp)
            For i = 1 To 22
                X(i) = X00 + X0(i) * Salp + Y0(i) * Calp
                Y(i) = Y00 - X0(i) * Calp + Y0(i) * Salp
            Next i
 '-----------------------------------------------------------
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(9), Y(9), 0, True, True
                .Add X(7), Y(7), 0, True, True
                .Add X(8), Y(8), 0, True, True
                .Add X(10), Y(10), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(11), Y(11), 0, True, True
                .Add X(13), Y(13), 0, True, True
                .Add X(15), Y(15), 0, True, True
                .Add X(16), Y(16), 0, True, True
                .Add X(14), Y(14), 0, True, True
                .Add X(12), Y(12), 0, True, True
            End With
 Dim xx#, yy#, xmid#, ymid#
            xmid = (X(9) + X(11)) / 2#
            ymid = (Y(9) + Y(11)) / 2#
            xx = X(17) + (xmid - X(17)) / Sin(Pi / 4)
            yy = Y(17) + (ymid - Y(17)) / Sin(Pi / 4)
            Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(9), Y(9), 0#, xx, yy, 0#, X(11), Y(11), 0)

            xmid = (X(10) + X(12)) / 2#
            ymid = (Y(10) + Y(12)) / 2#
            xx = X(18) + (xmid - X(18)) / Sin(Pi / 4)
            yy = Y(18) + (ymid - Y(18)) / Sin(Pi / 4)
            Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, xx, yy, 0#, X(12), Y(12), 0)

            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True
            Set GrHatch = Nothing
            Set GrGroup = Nothing
'-----------------------------------------------------------
           Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, True, True, False, False, False, False
                .Add X(12), Y(12), 0, False, True, False, False, False, False
                .Add X(14), Y(14), 0, True, True, False, False, False, False
                .Add X(16), Y(16), 0, True, True, False, False, False, False
                .Add X(15), Y(15), 0, True, True, False, False, False, False
                .Add X(13), Y(13), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, False, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False

            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Alp = Angle(Salp, Calp)
           '14
           Set GrChild = Gr.Graphics.AddArcCenterAndPoint(X(17), Y(17), 0#, X(11), Y(11), 0#, Pi / 2 + Alp - Pi / 2, Pi + Alp - Pi / 2)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcCenterAndPoint(X(18), Y(18), 0#, X(12), Y(12), 0#, Pi + Alp - Pi / 2, 3 * Pi / 2 + Alp - Pi / 2)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Gr.Vertices.Item(1).X = X(7)
            Gr.Vertices.Item(1).Y = Y(7)

            Gr.Vertices.Item(2).X = X(7)
            Gr.Vertices.Item(2).Y = Y(7)
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False
        End If
'##############################################################
'##############################################################
' View Top
         If ScrewView = "Top" Then
            X0(1) = Sqr(D / 2 * D / 2 - J / 2 * J / 2)
            Y0(1) = J / 2

            X0(2) = -X0(1)
            Y0(2) = Y0(1)

            X0(3) = X0(2)
            Y0(3) = -Y0(1)

            X0(4) = X0(1)
            Y0(4) = Y0(3)
            For i = 1 To 4
                X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
                Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
            Next i
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + D / 2, Y00, 0)
                  GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor

            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, False, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Gr.Vertices.Item(1).X = X00 + D / 2 * Calp
            Gr.Vertices.Item(1).Y = Y00 + D / 2 * Salp

            Gr.Vertices.Item(2).X = Gr.Vertices.Item(1).X
            Gr.Vertices.Item(2).Y = Gr.Vertices.Item(1).Y
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False
       End If
End Sub

'Slotted Round Head Cap Screw

Private Sub RHCScrew(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)

Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
        End With
Dim X0(18)
Dim Y0(18)
Dim X(18)
Dim Y(18)

Dim D#, H#, del#, J#, T#
        D = 1.6 * dd
        H = 0.68 * dd
        J = 0.2 * dd
        T = 0.4 * dd
        del = 0.1 * dd
Dim R#
        R = (H * H + D * D / 4) / (2 * H)
Dim xc#, yc#, LL#, sinb#, cosb#, alp1#, alp2#
        xc = R - H
        yc = 0
        X0(7) = 0
        Y0(7) = D / 2
        LL = Sqr((X0(7) - xc) * (X0(7) - xc) + (Y0(7) - yc) * (Y0(7) - yc))
        sinb = (Y0(7) - yc) / LL
        cosb = (X0(7) - xc) / LL
        alp1 = Angle(sinb, cosb)

        X0(9) = -H
        Y0(9) = J / 2
        LL = Sqr((X0(9) - xc) * (X0(9) - xc) + (Y0(9) - yc) * (Y0(9) - yc))
        sinb = (Y0(9) - yc) / LL
        cosb = (X0(9) - xc) / LL
        alp2 = Angle(sinb, cosb)
        X0(13) = xc + R * Cos((alp1 + alp2) / 2)
        Y0(13) = yc + R * Sin((alp1 + alp2) / 2)

        X0(14) = X0(13)
        Y0(14) = -Y0(13)

       X0(1) = 0#
       Y0(1) = dd / 2#

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = L - del
       Y0(3) = Y0(1)

       X0(4) = X0(3)
       Y0(4) = -Y0(3)

       X0(5) = L
       Y0(5) = dd / 2 - del

       X0(6) = X0(5)
       Y0(6) = -Y0(5)

       X0(7) = 0
       Y0(7) = D / 2

       X0(8) = X0(7)
       Y0(8) = -Y0(7)

       X0(9) = -H
       Y0(9) = J / 2

       X0(10) = X0(9)
       Y0(10) = -Y0(9)

       X0(11) = -H + T
       Y0(11) = Y0(9)

       X0(12) = X0(11)
       Y0(12) = -Y0(11)

 '-------------------------------
        If LThread > 0 Then
            X0(15) = X0(5) - LThread
        Else
            X0(15) = X0(5) - del
        End If
       Y0(15) = dd / 2#

       X0(16) = X0(15)
       Y0(16) = -Y0(15)

       X0(17) = X0(15)
       Y0(17) = Y0(15) - del

       X0(18) = X0(17)
       Y0(18) = -Y0(17)

Dim i%
       For i = 1 To 18
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
'#############################################################
'#############################################################
        If ScrewView = "FrontSection" Then
            Gr.Vertices.Item(2).Editable = True
            Gr.Vertices.Item(2).Selectable = True
'-----------------------------------------------------------
Dim GrGroup As Graphic
Dim GrHatch As Graphic
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True
                .Add X(1), Y(1), 0, True, True
                .Add X(3), Y(3), 0, True, True
                .Add X(5), Y(5), 0, True, True
                .Add X(6), Y(6), 0, True, True
                .Add X(4), Y(4), 0, True, True
                .Add X(2), Y(2), 0, True, True
                .Add X(8), Y(8), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(9), Y(9), 0, True, True
                .Add X(11), Y(11), 0, True, True
                .Add X(12), Y(12), 0, True, True
                .Add X(10), Y(10), 0, True, True
            End With
           Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(7), Y(7), 0#, X(13), Y(13), 0#, X(9), Y(9), 0#)
           Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(8), Y(8), 0#, X(14), Y(14), 0#, X(10), Y(10), 0#)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True
            Set GrHatch = Nothing
            Set GrGroup = Nothing
'-----------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, False, True, False, False, False, False
                .Add X(12), Y(12), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, False, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, False, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False

            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
    Dim Alp#
            Alp = Angle(Salp, Calp)
           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(7), Y(7), 0#, X(13), Y(13), 0#, X(9), Y(9), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(8), Y(8), 0#, X(14), Y(14), 0#, X(10), Y(10), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(15), Y(15), 0, True, True, False, False, False, False
                .Add X(16), Y(16), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(17), Y(17), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(18), Y(18), 0, False, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
        End If

'##############################################################
'##############################################################
        If ScrewView = "Front" Then
            If ScrewViewOld = "FrontSection" Then
Dim Calp2#, Salp2#
                Calp2 = Calp
                Salp2 = Salp
                Calp = -Salp2
                Salp = Calp2

            End If
            For i = 1 To 18
                X(i) = X00 + X0(i) * Salp + Y0(i) * Calp
                Y(i) = Y00 - X0(i) * Calp + Y0(i) * Salp
            Next i
'-----------------------------------------------------------
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True
                .Add X(8), Y(8), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(9), Y(9), 0, True, True
                .Add X(11), Y(11), 0, True, True
                .Add X(12), Y(12), 0, True, True
                .Add X(10), Y(10), 0, True, True
            End With
           Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(7), Y(7), 0#, X(13), Y(13), 0#, X(9), Y(9), 0#)
           Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(8), Y(8), 0#, X(14), Y(14), 0#, X(10), Y(10), 0#)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True
            Set GrHatch = Nothing
            Set GrGroup = Nothing
'-----------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, False, True, False, False, False, False
                .Add X(12), Y(12), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Alp = Angle(Salp, Calp)
           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(7), Y(7), 0#, X(13), Y(13), 0#, X(9), Y(9), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(8), Y(8), 0#, X(14), Y(14), 0#, X(10), Y(10), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Gr.Vertices.Item(1).X = X(7)
            Gr.Vertices.Item(1).Y = Y(7)

            Gr.Vertices.Item(2).X = X(7)
            Gr.Vertices.Item(2).Y = Y(7)
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False
        End If
'##############################################################
'##############################################################
' View Top
         If ScrewView = "Top" Then

Dim rr#
            rr = Sqr(R * R - (R - T) * (R - T))

            X0(1) = rr
            Y0(1) = J / 2

            X0(2) = -X0(1)
            Y0(2) = Y0(1)

            X0(3) = X0(2)
            Y0(3) = -Y0(1)

            X0(4) = X0(1)
            Y0(4) = Y0(3)

            X0(5) = X0(1)
            Y0(5) = Y0(1)

            For i = 1 To 5
                X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
                Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
            Next i
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + D / 2, Y00, 0)
                  GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor

            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
           End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Gr.Vertices.Item(1).X = X00 + D / 2 * Calp
            Gr.Vertices.Item(1).Y = Y00 + D / 2 * Salp

            Gr.Vertices.Item(2).X = Gr.Vertices.Item(1).X
            Gr.Vertices.Item(2).Y = Gr.Vertices.Item(1).Y
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False
       End If

End Sub

'Slotted Oval Countersunk Head Screw

Private Sub SOCHScrew(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)

Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
        End With
Dim X0(20)
Dim Y0(20)
Dim X(20)
Dim Y(20)

Dim D#, K#, del#, F#, J#, T#
        D = 2# * dd
        K = 0.5 * dd
        F = 0.23 * dd
        J = 0.26 * dd
        T = 0.4 * dd
        del = 0.1 * dd
Dim R#
        R = (F * F + D * D / 4) / (2 * F)
Dim xc#, yc#, LL#, sinb#, cosb#, alp1#, alp2#
        xc = R - F
        yc = 0
        X0(7) = 0
        Y0(7) = D / 2
        LL = Sqr((X0(7) - xc) * (X0(7) - xc) + (Y0(7) - yc) * (Y0(7) - yc))
        sinb = (Y0(7) - yc) / LL
        cosb = (X0(7) - xc) / LL
        alp1 = Angle(sinb, cosb)

        X0(9) = -F
        Y0(9) = J / 2
        LL = Sqr((X0(9) - xc) * (X0(9) - xc) + (Y0(9) - yc) * (Y0(9) - yc))
        sinb = (Y0(9) - yc) / LL
        cosb = (X0(9) - xc) / LL
        alp2 = Angle(sinb, cosb)
        X0(15) = xc + R * Cos((alp1 + alp2) / 2)
        Y0(15) = yc + R * Sin((alp1 + alp2) / 2)

        X0(16) = X0(15)
        Y0(16) = -Y0(15)

       X0(1) = K
       Y0(1) = dd / 2#

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = L - del
       Y0(3) = Y0(1)

       X0(4) = X0(3)
       Y0(4) = -Y0(3)

       X0(5) = L
       Y0(5) = dd / 2 - del

       X0(6) = X0(5)
       Y0(6) = -Y0(5)

       X0(7) = 0
       Y0(7) = D / 2

       X0(8) = X0(7)
       Y0(8) = -Y0(7)

       X0(9) = -F
       Y0(9) = J / 2

       X0(10) = X0(9)
       Y0(10) = -Y0(9)

       X0(11) = -F + T
       Y0(11) = Y0(9)

       X0(12) = X0(11)
       Y0(12) = -Y0(11)

       X0(13) = 0
       Y0(13) = Y0(9)

       X0(14) = X0(13)
       Y0(14) = -Y0(13)

 '-------------------------------
        If LThread > 0 Then
            X0(17) = X0(5) - LThread
        Else
            X0(17) = X0(5) - del
        End If
       Y0(17) = dd / 2#

       X0(18) = X0(17)
       Y0(18) = -Y0(17)

       X0(19) = X0(17)
       Y0(19) = Y0(17) - del

       X0(20) = X0(19)
       Y0(20) = -Y0(19)

Dim i%
       For i = 1 To 20
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
'#############################################################
'#############################################################
        If ScrewView = "FrontSection" Then
            Gr.Vertices.Item(2).Editable = True
            Gr.Vertices.Item(2).Selectable = True
'-----------------------------------------------------------
Dim GrGroup As Graphic
Dim GrHatch As Graphic
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True
                .Add X(1), Y(1), 0, True, True
                .Add X(3), Y(3), 0, True, True
                .Add X(5), Y(5), 0, True, True
                .Add X(6), Y(6), 0, True, True
                .Add X(4), Y(4), 0, True, True
                .Add X(2), Y(2), 0, True, True
                .Add X(8), Y(8), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(9), Y(9), 0, True, True
                .Add X(11), Y(11), 0, True, True
                .Add X(12), Y(12), 0, True, True
                .Add X(10), Y(10), 0, True, True
            End With
           Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(7), Y(7), 0#, X(15), Y(15), 0#, X(9), Y(9), 0#)
           Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(8), Y(8), 0#, X(16), Y(16), 0#, X(10), Y(10), 0#)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True
            Set GrHatch = Nothing
            Set GrGroup = Nothing
'-----------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, False, True, False, False, False, False
                .Add X(12), Y(12), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, False, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, False, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, False, True, False, False, False, False
                .Add X(13), Y(13), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, False, True, False, False, False, False
                .Add X(14), Y(14), 0, True, True, False, False, False, False

            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
    Dim Alp#
            Alp = Angle(Salp, Calp)
           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(7), Y(7), 0#, X(15), Y(15), 0#, X(9), Y(9), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(8), Y(8), 0#, X(16), Y(16), 0#, X(10), Y(10), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(17), Y(17), 0, True, True, False, False, False, False
                .Add X(18), Y(18), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(19), Y(19), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(20), Y(20), 0, False, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
            End With
             GrChild.Properties("PenColor") = PColor
       End If
'##############################################################
'##############################################################
        If ScrewView = "Front" Then
            If ScrewViewOld = "FrontSection" Then
Dim Calp2#, Salp2#
                Calp2 = Calp
                Salp2 = Salp
                Calp = -Salp2
                Salp = Calp2
            End If
            For i = 1 To 20
                X(i) = X00 + X0(i) * Salp + Y0(i) * Calp
                Y(i) = Y00 - X0(i) * Calp + Y0(i) * Salp
            Next i
'-----------------------------------------------------------
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True
                .Add X(13), Y(13), 0, True, True
                .Add X(9), Y(9), 0, True, True
            End With
           Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(7), Y(7), 0#, X(15), Y(15), 0#, X(9), Y(9), 0#)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True

            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(8), Y(8), 0, True, True
                .Add X(14), Y(14), 0, True, True
                .Add X(10), Y(10), 0, True, True
            End With
           Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(8), Y(8), 0#, X(16), Y(16), 0#, X(10), Y(10), 0#)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True

            Set GrHatch = Nothing
            Set GrGroup = Nothing
'-----------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, False, True, False, False, False, False
                .Add X(13), Y(13), 0, True, True, False, False, False, False
                .Add X(14), Y(14), 0, False, True, False, False, False, False
                .Add X(10), Y(10), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Alp = Angle(Salp, Calp)
           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(7), Y(7), 0#, X(15), Y(15), 0#, X(9), Y(9), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(8), Y(8), 0#, X(16), Y(16), 0#, X(10), Y(10), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Gr.Vertices.Item(1).X = X(7)
            Gr.Vertices.Item(1).Y = Y(7)

            Gr.Vertices.Item(2).X = X(7)
            Gr.Vertices.Item(2).Y = Y(7)
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False
        End If

'#################################################################
'#################################################################
        If ScrewView = "Top" Then
' View Top
Dim R1#
            R1 = D / 2 - dd / 2 * (T - F) / K

            X0(1) = Sqr(D / 2# * D / 2# - J / 2# * J / 2#)
            Y0(1) = J / 2#

            X0(2) = X0(1)
            Y0(2) = -Y0(1)

            X0(3) = Sqr(R1 * R1 - J / 2# * J / 2#)
            Y0(3) = Y0(1)

            X0(4) = X0(3)
            Y0(4) = -Y0(3)

            X0(5) = R1
            Y0(5) = 0#

            X0(6) = -X0(1)
            Y0(6) = Y0(1)

            X0(7) = -X0(2)
            Y0(7) = Y0(2)

            X0(8) = -X0(3)
            Y0(8) = Y0(3)

            X0(9) = -X0(4)
            Y0(9) = Y0(4)

            X0(10) = -X0(5)
            Y0(10) = Y0(5)

            X0(11) = 0
            Y0(11) = D / 2

            X0(12) = X0(11)
            Y0(12) = -Y0(11)
            For i = 1 To 12
                X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
                Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
            Next i
'------------------------------------------------------------
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True
                .Add X(3), Y(3), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(6), Y(6), 0, True, True
                .Add X(8), Y(8), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(2), Y(2), 0, True, True
                .Add X(4), Y(4), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True
                .Add X(9), Y(9), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(3), Y(3), 0#, X(5), Y(5), 0#, X(4), Y(4), 0#)
            Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(8), Y(8), 0#, X(10), Y(10), 0#, X(9), Y(9), 0#)
            Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(1), Y(1), 0#, X(11), Y(11), 0#, X(6), Y(6), 0#)
            Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(2), Y(2), 0#, X(12), Y(12), 0#, X(7), Y(7), 0#)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True
            Set GrHatch = Nothing
            Set GrGroup = Nothing
'------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True
                .Add X(6), Y(6), 0, True, True
                .Add X(7), Y(7), 0, False, True
                .Add X(2), Y(2), 0, True, True
            End With
            GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(3), Y(3), 0#, X(5), Y(5), 0#, X(4), Y(4), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(8), Y(8), 0#, X(10), Y(10), 0#, X(9), Y(9), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(1), Y(1), 0#, X(11), Y(11), 0#, X(6), Y(6), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(2), Y(2), 0#, X(12), Y(12), 0#, X(7), Y(7), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

            Gr.Vertices.Item(1).X = X00 + D / 2 * Calp
            Gr.Vertices.Item(1).Y = Y00 + D / 2 * Salp

            Gr.Vertices.Item(2).X = Gr.Vertices.Item(1).X
            Gr.Vertices.Item(2).Y = Gr.Vertices.Item(1).Y
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False

        End If

End Sub

'Slotted Fillister Head Cap Screw

Private Sub SFHCScrew(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)

Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
        End With
Dim X0(22)
Dim Y0(22)
Dim X(22)
Dim Y(22)

Dim D#, H#, del#, F#, J#, T#
        D = 1.3 * dd
        H = 0.77 * dd
        F = 0.65 * dd
        J = 0.175 * dd
        T = 0.33 * dd
        del = 0.1 * dd
Dim R#
        R = ((H - F) * (H - F) + D * D / 4) / (2 * (H - F))
Dim xc#, yc#, LL#, sinb#, cosb#, alp1#, alp2#
        xc = R - H
        yc = 0
        X0(9) = -F
        Y0(9) = D / 2
        LL = Sqr((X0(9) - xc) * (X0(9) - xc) + (Y0(9) - yc) * (Y0(9) - yc))
        sinb = (Y0(9) - yc) / LL
        cosb = (X0(9) - xc) / LL
        alp1 = Angle(sinb, cosb)

        X0(11) = -H
        Y0(11) = J / 2
        LL = Sqr((X0(11) - xc) * (X0(11) - xc) + (Y0(11) - yc) * (Y0(11) - yc))
        sinb = (Y0(11) - yc) / LL
        cosb = (X0(11) - xc) / LL
        alp2 = Angle(sinb, cosb)
        X0(17) = xc + R * Cos((alp1 + alp2) / 2)
        Y0(17) = yc + R * Sin((alp1 + alp2) / 2)

        X0(18) = X0(17)
        Y0(18) = -Y0(17)

       X0(1) = 0
       Y0(1) = dd / 2#

       X0(2) = X0(1)
       Y0(2) = -Y0(1)

       X0(3) = L - del
       Y0(3) = Y0(1)

       X0(4) = X0(3)
       Y0(4) = -Y0(3)

       X0(5) = L
       Y0(5) = dd / 2 - del

       X0(6) = X0(5)
       Y0(6) = -Y0(5)

       X0(7) = 0
       Y0(7) = D / 2

       X0(8) = X0(7)
       Y0(8) = -Y0(7)

       X0(9) = -F
       Y0(9) = D / 2

       X0(10) = X0(9)
       Y0(10) = -Y0(9)

       X0(11) = -H
       Y0(11) = J / 2

       X0(12) = X0(11)
       Y0(12) = -Y0(11)

       X0(13) = X0(11) + T
       Y0(13) = Y0(11)

       X0(14) = X0(13)
       Y0(14) = -Y0(13)

       X0(15) = X0(11) + (H - F)
       Y0(15) = Y0(11)

       X0(16) = X0(15)
       Y0(16) = -Y0(15)
 '-------------------------------
        If LThread > 0 Then
            X0(19) = X0(5) - LThread
        Else
            X0(19) = X0(5) - del
        End If
       Y0(19) = dd / 2#

       X0(20) = X0(19)
       Y0(20) = -Y0(19)

       X0(21) = X0(19)
       Y0(21) = Y0(19) - del

       X0(22) = X0(21)
       Y0(22) = -Y0(21)

Dim i%
       For i = 1 To 22
          X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
          Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
'#############################################################
'#############################################################
        If ScrewView = "FrontSection" Then
            Gr.Vertices.Item(2).Editable = True
            Gr.Vertices.Item(2).Selectable = True
'-----------------------------------------------------------
Dim GrGroup As Graphic
Dim GrHatch As Graphic
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(9), Y(9), 0, True, True
                .Add X(7), Y(7), 0, True, True
                .Add X(1), Y(1), 0, True, True
                .Add X(3), Y(3), 0, True, True
                .Add X(5), Y(5), 0, True, True
                .Add X(6), Y(6), 0, True, True
                .Add X(4), Y(4), 0, True, True
                .Add X(2), Y(2), 0, True, True
                .Add X(8), Y(8), 0, True, True
                .Add X(10), Y(10), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(11), Y(11), 0, True, True
                .Add X(13), Y(13), 0, True, True
                .Add X(14), Y(14), 0, True, True
                .Add X(12), Y(12), 0, True, True
            End With
           Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(9), Y(9), 0#, X(17), Y(17), 0#, X(11), Y(11), 0#)
           Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, X(18), Y(18), 0#, X(12), Y(12), 0#)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True
            Set GrHatch = Nothing
            Set GrGroup = Nothing
'-----------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, True, True, False, False, False, False
                .Add X(12), Y(12), 0, False, True, False, False, False, False
                .Add X(14), Y(14), 0, True, True, False, False, False, False
                .Add X(13), Y(13), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, False, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, False, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, False, True, False, False, False, False
                .Add X(15), Y(15), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, False, True, False, False, False, False
                .Add X(16), Y(16), 0, True, True, False, False, False, False

            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
    Dim Alp#
            Alp = Angle(Salp, Calp)
           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(9), Y(9), 0#, X(17), Y(17), 0#, X(11), Y(11), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, X(18), Y(18), 0#, X(12), Y(12), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(19), Y(19), 0, True, True, False, False, False, False
                .Add X(20), Y(20), 0, True, True, False, False, False, False
            End With
             GrChild.Properties("PenColor") = PColor
           Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(21), Y(21), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(22), Y(22), 0, False, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
        End If
'##############################################################
'##############################################################
        If ScrewView = "Front" Then
            If ScrewViewOld = "FrontSection" Then
Dim Calp2#, Salp2#
                Calp2 = Calp
                Salp2 = Salp
                Calp = -Salp2
                Salp = Calp2
            End If
            For i = 1 To 22
                X(i) = X00 + X0(i) * Salp + Y0(i) * Calp
                Y(i) = Y00 - X0(i) * Calp + Y0(i) * Salp
            Next i
'-----------------------------------------------------------
            Set GrGroup = Gr.Graphics.Add(gkGraphic)
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(9), Y(9), 0, True, True
                .Add X(7), Y(7), 0, True, True
                .Add X(8), Y(8), 0, True, True
                .Add X(10), Y(10), 0, True, True
            End With
            Set GrChild = GrGroup.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(11), Y(11), 0, True, True
                .Add X(13), Y(13), 0, True, True
                .Add X(14), Y(14), 0, True, True
                .Add X(12), Y(12), 0, True, True
            End With
           Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(9), Y(9), 0#, X(17), Y(17), 0#, X(11), Y(11), 0#)
           Set GrChild = GrGroup.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, X(18), Y(18), 0#, X(12), Y(12), 0#)
            Set GrHatch = GrGroup.Graphics.AddHatch
            GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrGroup.Deleted = True
            Set GrHatch = Nothing
            Set GrGroup = Nothing
'-----------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, True, True, False, False, False, False
                .Add X(12), Y(12), 0, False, True, False, False, False, False
                .Add X(14), Y(14), 0, True, True, False, False, False, False
                .Add X(13), Y(13), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, False, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, False, True, False, False, False, False
                .Add X(15), Y(15), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, False, True, False, False, False, False
                .Add X(16), Y(16), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Alp = Angle(Salp, Calp)
           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(9), Y(9), 0#, X(17), Y(17), 0#, X(11), Y(11), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, X(18), Y(18), 0#, X(12), Y(12), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Gr.Vertices.Item(1).X = X(7)
            Gr.Vertices.Item(1).Y = Y(7)

            Gr.Vertices.Item(2).X = X(7)
            Gr.Vertices.Item(2).Y = Y(7)
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False
        End If
'##############################################################
'##############################################################
' View Top
         If ScrewView = "Top" Then
            X0(1) = Sqr(D / 2 * D / 2 - J / 2 * J / 2)
            Y0(1) = J / 2

            X0(2) = -X0(1)
            Y0(2) = Y0(1)

            X0(3) = X0(2)
            Y0(3) = -Y0(1)

            X0(4) = X0(1)
            Y0(4) = Y0(3)
            For i = 1 To 4
                X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
                Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
            Next i
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + D / 2, Y00, 0)
                  GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                  GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, False, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Gr.Vertices.Item(1).X = X00 + D / 2 * Calp
            Gr.Vertices.Item(1).Y = Y00 + D / 2 * Salp

            Gr.Vertices.Item(2).X = Gr.Vertices.Item(1).X
            Gr.Vertices.Item(2).Y = Gr.Vertices.Item(1).Y
            Gr.Vertices.Item(2).Editable = False
            Gr.Vertices.Item(2).Selectable = False
       End If

End Sub


Examples - Fastener Regen - frmFasteners.frm

frmFasteners.frm

Fastener Regen Example

VERSION 5.00
Begin VB.Form frmFasteners
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Bolts and Screws"
   ClientHeight    =   3975
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6600
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   265
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   440
   StartUpPosition =   1  'CenterOwner
   Begin VB.ListBox List2
      Height          =   255
      ItemData        =   "frmFasteners.frx":0000
      Left            =   4800
      List            =   "frmFasteners.frx":000D
      TabIndex        =   7
      Top             =   120
      Width           =   1575
   End
   Begin VB.TextBox txtThread
      Height          =   288
      Left            =   1920
      TabIndex        =   5
      Top             =   3600
      Width           =   855
   End
   Begin VB.ListBox List1
      Height          =   2205
      ItemData        =   "frmFasteners.frx":002B
      Left            =   120
      List            =   "frmFasteners.frx":0050
      TabIndex        =   4
      Top             =   480
      Width           =   2655
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   3480
      TabIndex        =   3
      Top             =   3480
      Width           =   1335
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   5040
      TabIndex        =   2
      Top             =   3480
      Width           =   1335
   End
   Begin VB.TextBox txtdd
      Height          =   285
      Left            =   1920
      TabIndex        =   1
      Top             =   2880
      Width           =   855
   End
   Begin VB.TextBox txtLen
      Height          =   285
      Left            =   1920
      TabIndex        =   0
      Top             =   3240
      Width           =   855
   End
   Begin VB.Image PicPreview
      BorderStyle     =   1  'Fixed Single
      Height          =   1950
      Left            =   3000
      Stretch         =   -1  'True
      Top             =   600
      Width           =   3300
   End
   Begin VB.Label Label8
      Alignment       =   1  'Right Justify
      Caption         =   "Diameter (d) :"
      Height          =   255
      Left            =   720
      TabIndex        =   10
      Top             =   2880
      Width           =   975
   End
   Begin VB.Label Label7
      Alignment       =   1  'Right Justify
      Caption         =   "Length (L) :"
      Height          =   255
      Left            =   720
      TabIndex        =   9
      Top             =   3240
      Width           =   975
   End
   Begin VB.Label Label6
      Alignment       =   1  'Right Justify
      Caption         =   "Length of thread (Lt) :"
      Height          =   255
      Left            =   120
      TabIndex        =   8
      Top             =   3600
      Width           =   1575
   End
   Begin VB.Label Label4
      Caption         =   "Bolt Type :"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   120
      Width           =   975
   End
End
Attribute VB_Name = "frmFasteners"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Me.Hide
End Sub

Private Sub Form_Load()
Dim i%, iDef%
    For i = 0 To List1.ListCount - 1
        If List1.List(i) = TypeB Then iDef = i
    Next i
    List1.ListIndex = iDef
    For i = 0 To List2.ListCount - 1
        If List2.List(i) = ViewB Then iDef = i
    Next i
    List2.ListIndex = iDef
  '  HexBolt.Visible = False
  '  SlottedBolt.Visible = False
  '  RHBolt.Visible = False
  '  THeadBolt.Visible = False
  '  SquareBolt.Visible = False
  '  HexFlScrew.Visible = False
  '  SPHScrew.Visible = False
  '  RHCScrew.Visible = False
  '  SOCHScrew.Visible = False
  '  SFHCScrew.Visible = False
  '  RHSNBolt.Visible = False
'    If List1.Text = "HexBolt" Then HexBolt.Visible = True
'    If List1.Text = "SlottedBolt" Then SlottedBolt.Visible = True
'    If List1.Text = "RHBolt" Then RHBolt.Visible = True
'    If List1.Text = "THeadBolt" Then THeadBolt.Visible = True
'    If List1.Text = "SquareBolt" Then SquareBolt.Visible = True
'    If List1.Text = "HexFlScrew" Then HexFlScrew.Visible = True
'    If List1.Text = "SPHScrew" Then SPHScrew.Visible = True
'    If List1.Text = "RHCScrew" Then RHCScrew.Visible = True
'    If List1.Text = "SOCHScrew" Then SOCHScrew.Visible = True
'    If List1.Text = "SFHCScrew" Then SFHCScrew.Visible = True
'    If List1.Text = "RHSNBolt" Then RHSNBolt.Visible = True

    If List1.Text = "HexBolt" Then PicPreview.Picture = LoadResPicture(101, 0)
    If List1.Text = "SlottedBolt" Then PicPreview.Picture = LoadResPicture(102, 0)
    If List1.Text = "RHBolt" Then PicPreview.Picture = LoadResPicture(103, 0)
    If List1.Text = "THeadBolt" Then PicPreview.Picture = LoadResPicture(104, 0)
    If List1.Text = "SquareBolt" Then PicPreview.Picture = LoadResPicture(105, 0)
    If List1.Text = "HexFlScrew" Then PicPreview.Picture = LoadResPicture(106, 0)
    If List1.Text = "SPHScrew" Then PicPreview.Picture = LoadResPicture(107, 0)
    If List1.Text = "RHCScrew" Then PicPreview.Picture = LoadResPicture(108, 0)
    If List1.Text = "SOCHScrew" Then PicPreview.Picture = LoadResPicture(109, 0)
    If List1.Text = "SFHCScrew" Then PicPreview.Picture = LoadResPicture(110, 0)
    If List1.Text = "RHSNBolt" Then PicPreview.Picture = LoadResPicture(111, 0)

End Sub

Private Sub List1_Click()
'    HexBolt.Visible = False
'    SlottedBolt.Visible = False
'    RHBolt.Visible = False
'    THeadBolt.Visible = False
'    SquareBolt.Visible = False
'    HexFlScrew.Visible = False
'    SPHScrew.Visible = False
'    RHCScrew.Visible = False
'    SOCHScrew.Visible = False
'    SFHCScrew.Visible = False
'    RHSNBolt.Visible = False
'    If List1.Text = "HexBolt" Then HexBolt.Visible = True
'    If List1.Text = "SlottedBolt" Then SlottedBolt.Visible = True
'    If List1.Text = "RHBolt" Then RHBolt.Visible = True
'    If List1.Text = "THeadBolt" Then THeadBolt.Visible = True
'    If List1.Text = "SquareBolt" Then SquareBolt.Visible = True
'    If List1.Text = "HexFlScrew" Then HexFlScrew.Visible = True
'    If List1.Text = "SPHScrew" Then SPHScrew.Visible = True
'    If List1.Text = "RHCScrew" Then RHCScrew.Visible = True
'    If List1.Text = "SOCHScrew" Then SOCHScrew.Visible = True
'    If List1.Text = "SFHCScrew" Then SFHCScrew.Visible = True
'    If List1.Text = "RHSNBolt" Then RHSNBolt.Visible = True

    If List1.Text = "HexBolt" Then PicPreview.Picture = LoadResPicture(101, 0)
    If List1.Text = "SlottedBolt" Then PicPreview.Picture = LoadResPicture(102, 0)
    If List1.Text = "RHBolt" Then PicPreview.Picture = LoadResPicture(103, 0)
    If List1.Text = "THeadBolt" Then PicPreview.Picture = LoadResPicture(104, 0)
    If List1.Text = "SquareBolt" Then PicPreview.Picture = LoadResPicture(105, 0)
    If List1.Text = "HexFlScrew" Then PicPreview.Picture = LoadResPicture(106, 0)
    If List1.Text = "SPHScrew" Then PicPreview.Picture = LoadResPicture(107, 0)
    If List1.Text = "RHCScrew" Then PicPreview.Picture = LoadResPicture(108, 0)
    If List1.Text = "SOCHScrew" Then PicPreview.Picture = LoadResPicture(109, 0)
    If List1.Text = "SFHCScrew" Then PicPreview.Picture = LoadResPicture(110, 0)
    If List1.Text = "RHSNBolt" Then PicPreview.Picture = LoadResPicture(111, 0)

End Sub


Examples - Fastener Regen - modFasteners.bas

modFasteners.bas

Fastener Regen Example

Attribute VB_Name = "modFasteners"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
Global Const Pi = 3.14159
Global TypeB As String
Global ViewB As String
' DLL Entry point
Sub Main()

End Sub


Examples - %%PROJECT_NAME%%Gear.bas

Gear.bas

Attribute VB_Name = "modGear"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' DLL Entry point
Sub Main()

End Sub


Examples - %%PROJECT_NAME%%Gear.cls

Gear.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Bearing"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idTeethNum = 1
Const IdD0 = 2
Const idH0 = 3
Const IdD1 = 4
Const IdD2 = 5
Const idH1 = 6
Const IdDi = 7
Const idH2 = 8
Const idH3 = 9
Const idH4 = 10
'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 10
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "SDK Gear"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{D25185FF-6A20-11d0-A115-00A024158DAF}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
' Number of teeth on the gear
    Names(0) = "TeethNum"
    Types(0) = typeInteger
    IDs(0) = idTeethNum
    Defaults(0) = 40

    Names(1) = "D0"
    Types(1) = typeDouble
    IDs(1) = IdD0
    Defaults(1) = 3.5

    Names(2) = "H0"
    Types(2) = typeDouble
    IDs(2) = idH0
    Defaults(2) = 0.5

    Names(3) = "D1"
    Types(3) = typeDouble
    IDs(3) = IdD1
    Defaults(3) = 2.5

    Names(4) = "D2"
    Types(4) = typeDouble
    IDs(4) = IdD2
    Defaults(4) = 1.5

    Names(5) = "H1"
    Types(5) = typeDouble
    IDs(5) = idH1
    Defaults(5) = 0.25

    Names(6) = "Di"
    Types(6) = typeDouble
    IDs(6) = IdDi
    Defaults(6) = 1#

    Names(7) = "H2"
    Types(7) = typeDouble
    IDs(7) = idH2
    Defaults(7) = 0.75

    Names(8) = "H3"
    Types(8) = typeDouble
    IDs(8) = idH3
    Defaults(8) = 1.5

    Names(9) = "H4"
    Types(9) = typeDouble
    IDs(9) = idH4
    Defaults(9) = 1#

    GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmGear
    Names(0) = frmGear.Caption
    Unload frmGear

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
    GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed

        Dim TeethNum%, D0#, H0#, D1#, D2#, H1#, Di#, H2#, H3#, H4#
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmGear
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next

                'When the property page is closed, transfer the numeric
                'roundness value from the TextBox to the Graphic
                'Get the value as a double-precision number
                TeethNum = CInt(.txtTeethNum.Text)
                D0 = CDbl(.OutsideDiam.Text)
                H0 = CDbl(.H0.Text)
                D1 = CDbl(.D1.Text)
                D2 = CDbl(.D2.Text)
                H1 = CDbl(.H1.Text)
                Di = CDbl(.Di.Text)
                H2 = CDbl(.H2.Text)
                H3 = CDbl(.H3.Text)
                H4 = CDbl(.H4.Text)

                'Make sure it's between 0 and 100
                If TeethNum < 10 Then TeethNum = 10
                If D0 < 0 Then D0 = 1
'                If Roundness# > 100# Then Roundness# = 100#
                'Set the roundness property value in the Graphic
                Graphic.Properties("TeethNum") = TeethNum
                Graphic.Properties("D0") = D0
                Graphic.Properties("H0") = H0
                Graphic.Properties("D1") = D1
                Graphic.Properties("D2") = D2
                Graphic.Properties("H1") = H1
                Graphic.Properties("Di") = Di
                Graphic.Properties("H2") = H2
                Graphic.Properties("H3") = H3
                Graphic.Properties("H4") = H4

            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmGear
            With frmGear
                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                'roundness value from the Graphic to the TextBox
                'Get the roundness property value from the Graphic
                TeethNum = Graphic.Properties("TeethNum")
                D0 = Graphic.Properties("D0")
                H0 = Graphic.Properties("H0")
                D1 = Graphic.Properties("D1")
                D2 = Graphic.Properties("D2")
                H1 = Graphic.Properties("H1")
                Di = Graphic.Properties("Di")
                H2 = Graphic.Properties("H2")
                H3 = Graphic.Properties("H3")
                H4 = Graphic.Properties("H4")
               'Set the TextBox control's text
                .txtTeethNum.Text = CStr(TeethNum)
                .OutsideDiam.Text = CStr(D0)
                .H0.Text = CStr(H0)
                .D1.Text = CStr(D1)
                .D2.Text = CStr(D2)
                .H1.Text = CStr(H1)
                .Di.Text = CStr(Di)
                .H2.Text = CStr(H2)
                .H3.Text = CStr(H3)
                .H4.Text = CStr(H4)
NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
'            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmGear
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmGear
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If

    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "Center" of detail
    grfThis.Vertices.Add 5#, 5#, 0#, False, True, False, False, False
    'Second Vertex is "upper right" corner
'    grfThis.Vertices.Add 5#, 5#, 3#, False, True, False, False, False

    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis As Object)
        'Setup error handler
        On Error GoTo Failed

        'grfThis.Application.PushVertexDefaults Editable:=True, Selectable:=True

        'Set up lock (prevent recursion)
        Dim LockCount&
        LockCount& = grfThis.RegenLock
Dim NumCosm As Long, iCosm As Long
        iCosm = 1
        NumCosm = grfThis.Graphics.Count
        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
'            grfThis.Graphics.Clear gfCosmetic

            'Add child Graphics
            Dim grfChild As Object
            Dim x0#, y0#, Z0#, x1#, y1#, Z1#
            With grfThis.Vertices
                x0# = .Item(0).X
                y0# = .Item(0).Y
                Z0# = .Item(0).Z
'                x1# = .Item(1).X
'                y1# = .Item(1).Y
'                Z1# = .Item(1).Z
            End With
Dim TeethNum%
        TeethNum = grfThis.Properties("TeethNum")

Dim D0#, D1# 'External diameter
        D0 = grfThis.Properties("D0")
        D1 = grfThis.Properties("D1")

Dim n As Long
    n = TeethNum
Dim Rext#, Rint#, r1#, r2#, r3#
Dim fi#, dfi#, alp#, bet#, gam#
Dim xc#, yc#, zc#
Dim h#, H0#, H2#, H3#, H4#, H1#
        H0 = grfThis.Properties("H0")
Dim i As Long, j As Long
    Rext = D0 / 2
Dim m#
    m = D0 / (n + 2)
    h = 2.25 * m
    Rint = Rext - h
    r1 = D1 / 2
    xc = x0
    yc = y0
    zc = Z0 - H0
    dfi = 2 * Pi / n
    alp = Pi / 3 / n
    bet = Pi / 3 / n
    gam = Pi / 3 / n
Dim Vers As Vertices
Dim Ver As Vertex
Dim xi#, yi#, zi#
Dim grChild As Graphic
    zi = zc
    j = 0
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If

'###############################################################
    Set Vers = grChild.Vertices
    For i = 0 To n - 1
        fi = i * dfi
        If i = 0 Then
            xi = xc + Rint * Cos(fi - (alp + bet))
            yi = yc + Rint * Sin(fi - (alp + bet))
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
        j = j + 1
        xi = xc + Rext * Cos(fi - alp)
        yi = yc + Rext * Sin(fi - alp)
        Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        xi = xc + Rext * Cos(fi + alp)
        yi = yc + Rext * Sin(fi + alp)
        Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        xi = xc + Rint * Cos(fi + (alp + bet))
        yi = yc + Rint * Sin(fi + (alp + bet))
        Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        xi = xc + Rint * Cos(fi + (alp + bet + 2 * gam))
        yi = yc + Rint * Sin(fi + (alp + bet + 2 * gam))
        Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
    Next i
Dim xCon#, yCon#, zCon#
    xCon = xi
    yCon = yi
    zCon = zi

    dfi = 2 * Pi / 30
    For i = 0 To 30
        fi = -i * dfi
        xi = xc + r1 * Cos(fi)
        yi = yc + r1 * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False, True, True, True, True, False)

    grChild.Closed = True
    grChild.Properties("PenColor") = QBColor(8)
    grChild.Properties("Thickness") = 2 * H0
    grChild.Properties("Solid") = 0

' ----------------------------------------------------------------------
Dim D2#
        D2 = grfThis.Properties("D2")
        H1 = grfThis.Properties("H1")
    r1 = D1 / 2
    r2 = D2 / 2
    xc = x0
    yc = y0
    zc = Z0 - H1
    zi = zc
    dfi = 2 * Pi / 30
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################

    For i = 0 To 30
        fi = i * dfi
        xi = xc + r1 * Cos(fi)
        yi = yc + r1 * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + r2 * Cos(fi)
        yi = yc + r2 * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False, True, True, True, True, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = QBColor(8)
    grChild.Properties("Thickness") = 2 * H1
    grChild.Properties("Solid") = 0

' ----------------------------------------------------------------------
Dim Di#, ri#
        Di = grfThis.Properties("Di")
        H2 = grfThis.Properties("H2")
    r2 = D2 / 2
    ri = Di / 2
    xc = x0
    yc = y0
    zc = Z0 - H2
    zi = zc
    dfi = 2 * Pi / 30
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################
    For i = 0 To 30
        fi = i * dfi
        xi = xc + r2 * Cos(fi)
        yi = yc + r2 * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + ri * Cos(fi)
        yi = yc + ri * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False, True, True, True, True, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = QBColor(8)
    grChild.Properties("Thickness") = 2 * H2
    grChild.Properties("Solid") = 0
' ----------------------------------------------------------------------
    H3 = grfThis.Properties("H3")
'    r3 = 0.25 * Rint
    xc = x0
    yc = y0
'    H4 = H1 * 3
    zc = Z0 - H3
    zi = zc
    dfi = 2 * Pi / 30
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################
    For i = 0 To 30
        fi = i * dfi
        xi = xc + ri * Cos(fi)
        yi = yc + ri * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    grChild.Closed = True
    grChild.Properties("PenColor") = QBColor(8)
    grChild.Properties("Thickness") = 2 * H3
    grChild.Properties("Solid") = 0

' End gear
' --------------------------------------------------------------------------
' --------------------------------------------------------------------------
' --------------------------------------------------------------------------
' Begin Bearings  -  1
    H4 = grfThis.Properties("H4")

 Dim rb1#, rb2#, rb3#, rb4#
 Dim hb#
 Dim rr#
 Dim zb#
    rr = 0.2 * ri
    hb = 2 * rr
    zb = H4

'  First ring
    rb1 = ri
    rb2 = rb1 + hb / 4
    xc = x0
    yc = y0
    zi = zb
    dfi = 2 * Pi / 30
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################
    For i = 0 To 30
        fi = i * dfi
        xi = xc + rb2 * Cos(fi)
        yi = yc + rb2 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + rb1 * Cos(fi)
        yi = yc + rb1 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False, True, True, True, True, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = RGB(0, 0, 255)
    grChild.Properties("Thickness") = hb
    grChild.Properties("Solid") = 0
' --------------------------------------------------------------------

'  Second ring
    rb3 = rb2 + 2 * rr
    rb4 = rb3 + hb / 4
    xc = x0
    yc = y0
    zi = zb
    dfi = 2 * Pi / 30
 '###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################
   For i = 0 To 30
        fi = i * dfi
        xi = xc + rb4 * Cos(fi)
        yi = yc + rb4 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + rb3 * Cos(fi)
        yi = yc + rb3 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False, True, True, True, True, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = RGB(0, 0, 255)
    grChild.Properties("Thickness") = hb
    grChild.Properties("Solid") = 0
' --------------------------------------------------------------------
' Draw Bolls as spheres
    zi = zb + hb / 2
    dfi = 2 * Pi / 16
    For i = 0 To 16
        fi = i * dfi
        xi = xc + (rb2 + rr) * Cos(fi)
        yi = yc + (rb2 + rr) * Sin(fi)
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(, "TCW40SPHERE")
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################

'        Set grChild = grfThis.Graphics.Add(, "TCW40SPHERE")
'                grChild.Cosmetic = True
        Set Ver = grChild.Vertices.Add(xi, yi, zi, False, False, False, False, False, False)
        Set Ver = grChild.Vertices.Add(xi, yi, zi + rr, False, False, False, False, False, False)
        grChild.Properties("PenColor") = QBColor(4)
        grChild.Properties("Solid") = 0
    Next i

' --------------------------------------------------------------------------
' --------------------------------------------------------------------------
' --------------------------------------------------------------------------
' Begin Bearings  -  2
    rr = 0.2 * ri
    hb = 2 * rr
    zb = -H4 - hb

'  First ring
    rb1 = ri
    rb2 = rb1 + hb / 4
    xc = x0
    yc = y0
    zi = zb
    dfi = 2 * Pi / 30
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################
    For i = 0 To 30
        fi = i * dfi
        xi = xc + rb2 * Cos(fi)
        yi = yc + rb2 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + rb1 * Cos(fi)
        yi = yc + rb1 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False, True, True, True, True, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = RGB(0, 0, 255)
    grChild.Properties("Thickness") = hb
    grChild.Properties("Solid") = 0
' --------------------------------------------------------------------

'  Second ring
    rb3 = rb2 + 2 * rr
    rb4 = rb3 + hb / 4
    xc = x0
    yc = y0
    zi = zb
    dfi = 2 * Pi / 30
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################
    For i = 0 To 30
        fi = i * dfi
        xi = xc + rb4 * Cos(fi)
        yi = yc + rb4 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + rb3 * Cos(fi)
        yi = yc + rb3 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False, True, True, True, True, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = RGB(0, 0, 255)
    grChild.Properties("Thickness") = hb
    grChild.Properties("Solid") = 0
' --------------------------------------------------------------------
' Draw Bolls as spheres
    zi = zb + hb / 2
    dfi = 2 * Pi / 16
    For i = 0 To 16
        fi = i * dfi
        xi = xc + (rb2 + rr) * Cos(fi)
        yi = yc + (rb2 + rr) * Sin(fi)
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(, "TCW40SPHERE")
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################
'        Set grChild = grfThis.Graphics.Add(, "TCW40SPHERE")
'            grChild.Cosmetic = True
        Set Ver = grChild.Vertices.Add(xi, yi, zi, False, False, False, False, False, False)
        Set Ver = grChild.Vertices.Add(xi, yi, zi + rr, False, False, False, False, False, False)
        grChild.Properties("PenColor") = QBColor(4)
        grChild.Properties("Solid") = 0
   Next i

            'Add visible child Graphics
        End If

        grfThis.RegenUnlock
        'grfThis.Application.PopVertexDefaults
        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:
        'grfThis.Application.PopVertexDefaults

        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function


Examples - %%PROJECT_NAME%%Gear.frm

Gear.frm

VERSION 5.00
Begin VB.Form frmGear
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Gear with Ball Bearing"
   ClientHeight    =   5640
   ClientLeft      =   6420
   ClientTop       =   2895
   ClientWidth     =   7590
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   5640
   ScaleWidth      =   7590
   Begin VB.TextBox H4
      Height          =   288
      Left            =   6720
      TabIndex        =   23
      Top             =   4680
      Width           =   732
   End
   Begin VB.TextBox H3
      Height          =   288
      Left            =   6720
      TabIndex        =   21
      Top             =   4200
      Width           =   732
   End
   Begin VB.TextBox H2
      Height          =   288
      Left            =   6720
      TabIndex        =   19
      Top             =   3720
      Width           =   732
   End
   Begin VB.TextBox H1
      Height          =   288
      Left            =   6720
      TabIndex        =   17
      Top             =   3240
      Width           =   732
   End
   Begin VB.TextBox H0
      Height          =   288
      Left            =   6720
      TabIndex        =   15
      Top             =   2760
      Width           =   732
   End
   Begin VB.TextBox Di
      Height          =   288
      Left            =   6720
      TabIndex        =   13
      Top             =   2280
      Width           =   732
   End
   Begin VB.TextBox D2
      Height          =   288
      Left            =   6720
      TabIndex        =   11
      Top             =   1800
      Width           =   732
   End
   Begin VB.TextBox D1
      Height          =   288
      Left            =   6720
      TabIndex        =   9
      Top             =   1320
      Width           =   732
   End
   Begin VB.TextBox OutsideDiam
      Height          =   288
      Left            =   6720
      TabIndex        =   7
      Top             =   840
      Width           =   732
   End
   Begin VB.TextBox CircPitch
      Enabled         =   0   'False
      Height          =   285
      Left            =   6720
      TabIndex        =   5
      Top             =   5160
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.PictureBox Picture1
      AutoSize        =   -1  'True
      Height          =   6180
      Left            =   0
      Picture         =   "Gear.frx":0000
      ScaleHeight     =   6120
      ScaleWidth      =   5925
      TabIndex        =   4
      Top             =   120
      Width           =   5985
   End
   Begin VB.TextBox txtTeethNum
      Height          =   285
      Left            =   6720
      TabIndex        =   3
      Text            =   "40"
      Top             =   360
      Width           =   735
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   1680
      TabIndex        =   0
      Top             =   5160
      Width           =   1092
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   3360
      TabIndex        =   1
      Top             =   5160
      Width           =   1092
   End
   Begin VB.Label Label11
      Caption         =   "H4="
      Height          =   252
      Left            =   6240
      TabIndex        =   24
      Top             =   4680
      Width           =   372
   End
   Begin VB.Label Label10
      Caption         =   "H3="
      Height          =   252
      Left            =   6240
      TabIndex        =   22
      Top             =   4200
      Width           =   372
   End
   Begin VB.Label Label9
      Caption         =   "H2="
      Height          =   252
      Left            =   6240
      TabIndex        =   20
      Top             =   3720
      Width           =   372
   End
   Begin VB.Label Label8
      Caption         =   "H1="
      Height          =   252
      Left            =   6240
      TabIndex        =   18
      Top             =   3240
      Width           =   372
   End
   Begin VB.Label Label7
      Caption         =   "H="
      Height          =   252
      Left            =   6240
      TabIndex        =   16
      Top             =   2760
      Width           =   252
   End
   Begin VB.Label Label6
      Caption         =   "Di="
      Height          =   252
      Left            =   6240
      TabIndex        =   14
      Top             =   2280
      Width           =   252
   End
   Begin VB.Label Label5
      Caption         =   "D2="
      Height          =   252
      Left            =   6240
      TabIndex        =   12
      Top             =   1800
      Width           =   372
   End
   Begin VB.Label Label4
      Caption         =   "D1="
      Height          =   252
      Left            =   6240
      TabIndex        =   10
      Top             =   1320
      Width           =   372
   End
   Begin VB.Label Label3
      Caption         =   "OutsideDiameter D="
      Height          =   372
      Left            =   5040
      TabIndex        =   8
      Top             =   840
      Width           =   1572
   End
   Begin VB.Label Label2
      Caption         =   "Circular pitch="
      Height          =   252
      Left            =   5520
      TabIndex        =   6
      Top             =   5160
      Visible         =   0   'False
      Width           =   1092
   End
   Begin VB.Label Label1
      Caption         =   "Number of Teeth="
      Height          =   252
      Left            =   5280
      TabIndex        =   2
      Top             =   360
      Width           =   1332
   End
End
Attribute VB_Name = "frmGear"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
'    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Me.Hide
End Sub


Examples - Hole Regen - frmHole.frm

frmHole.frm

Hole Regen Example

VERSION 5.00
Begin VB.Form frmHole
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Holes"
   ClientHeight    =   4140
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5460
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   276
   ScaleMode       =   0  'User
   ScaleWidth      =   364
   StartUpPosition =   1  'CenterOwner
   Begin VB.TextBox txtThread
      Height          =   288
      Left            =   1785
      TabIndex        =   5
      Top             =   3195
      Width           =   612
   End
   Begin VB.ListBox List1
      Height          =   1425
      ItemData        =   "frmHole.frx":0000
      Left            =   105
      List            =   "frmHole.frx":0013
      TabIndex        =   4
      Top             =   510
      Width           =   2310
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   2610
      TabIndex        =   3
      Top             =   3630
      Width           =   1200
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   4140
      TabIndex        =   2
      Top             =   3615
      Width           =   1200
   End
   Begin VB.TextBox txtdd
      Height          =   285
      Left            =   1785
      TabIndex        =   1
      Top             =   2235
      Width           =   615
   End
   Begin VB.TextBox txtLen
      Height          =   285
      Left            =   1785
      TabIndex        =   0
      Top             =   2715
      Width           =   615
   End
   Begin VB.Image PicPreview
      BorderStyle     =   1  'Fixed Single
      Height          =   3300
      Left            =   2610
      Stretch         =   -1  'True
      Top             =   135
      Width           =   2700
   End
   Begin VB.Label Label8
      Alignment       =   1  'Right Justify
      Caption         =   "Diameter (d) :"
      Height          =   255
      Left            =   345
      TabIndex        =   9
      Top             =   2235
      Width           =   1335
   End
   Begin VB.Label Label7
      Alignment       =   1  'Right Justify
      Caption         =   "Lenght (L) :"
      Height          =   255
      Left            =   705
      TabIndex        =   8
      Top             =   2715
      Width           =   975
   End
   Begin VB.Label Label6
      Alignment       =   1  'Right Justify
      Caption         =   "Length of thread (Lt) :"
      Height          =   255
      Left            =   105
      TabIndex        =   7
      Top             =   3195
      Width           =   1575
   End
   Begin VB.Label Label4
      Caption         =   "Hole Type :"
      Height          =   255
      Left            =   120
      TabIndex        =   6
      Top             =   120
      Width           =   975
   End
End
Attribute VB_Name = "frmHole"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Me.Hide
End Sub

Private Sub Form_Load()
Dim i%, iDef%
    For i = 0 To List1.ListCount - 1
        If List1.List(i) = TypeH Then iDef = i
    Next i
    List1.ListIndex = iDef
'    Hole1.Visible = False
'    Hole2.Visible = False
'    Hole3.Visible = False
'    Hole4.Visible = False
'    Hole5.Visible = False

    If List1.Text = "Hole1" Then PicPreview.Picture = LoadResPicture(101, 0)
    If List1.Text = "Hole2" Then PicPreview.Picture = LoadResPicture(102, 0)
    If List1.Text = "Hole3" Then PicPreview.Picture = LoadResPicture(103, 0)
    If List1.Text = "Hole4" Then PicPreview.Picture = LoadResPicture(104, 0)
    If List1.Text = "Hole5" Then PicPreview.Picture = LoadResPicture(105, 0)

'    If List1.Text = "Hole1" Then Hole1.Visible = True
'    If List1.Text = "Hole2" Then Hole2.Visible = True
'    If List1.Text = "Hole3" Then Hole3.Visible = True
'    If List1.Text = "Hole4" Then Hole4.Visible = True
'    If List1.Text = "Hole5" Then Hole5.Visible = True

End Sub

Private Sub List1_Click()
'    Hole1.Visible = False
'    Hole2.Visible = False
'    Hole3.Visible = False
'    Hole4.Visible = False
'    Hole5.Visible = False
'    If List1.Text = "Hole1" Then Hole1.Visible = True
'    If List1.Text = "Hole2" Then Hole2.Visible = True
'    If List1.Text = "Hole3" Then Hole3.Visible = True
'    If List1.Text = "Hole4" Then Hole4.Visible = True
'    If List1.Text = "Hole5" Then Hole5.Visible = True

    If List1.Text = "Hole1" Then PicPreview.Picture = LoadResPicture(101, 0)
    If List1.Text = "Hole2" Then PicPreview.Picture = LoadResPicture(102, 0)
    If List1.Text = "Hole3" Then PicPreview.Picture = LoadResPicture(103, 0)
    If List1.Text = "Hole4" Then PicPreview.Picture = LoadResPicture(104, 0)
    If List1.Text = "Hole5" Then PicPreview.Picture = LoadResPicture(105, 0)

End Sub


Examples - Hole Regen - Hole.bas

Hole.bas

Hole Regen Example

Attribute VB_Name = "modHole"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
Global Const Pi = 3.14159
Global TypeH As String
Global ViewH As String
' DLL Entry point
Sub Main()

End Sub


Examples - Hole Regen - Hole.cls

Hole.cls

Hole Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Detail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2000                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idDiameter = 1
Const idLength = 2
Const idHType = 3
Const idHoleView = 4

Const idLengthOld = 5
Const idLengthThread = 6

Const idDiameterOld = 7
Const idHTypeOld = 8
Const idHoleViewOld = 9
Const idLengthThreadOld = 10

Const idX0Old = 11
Const idY0Old = 12
Const idX1Old = 13
Const idY1Old = 14
Const idX2Old = 15
Const idY2Old = 16

'Property enums
Const NUM_TYPES = 0

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 16
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private PColor As Long
Private BColor As Long

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "Holes"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{FDB6F1C3-9631-11d1-A40A-0000B465872B}"

End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)

    Names(0) = "DiameterH"
    Types(0) = typeDouble
    IDs(0) = idDiameter
    Defaults(0) = 1#

    Names(1) = "LengthH"
    Types(1) = typeDouble
    IDs(1) = idLength
    Defaults(1) = 3#

    Names(2) = "HType"
    Types(2) = typeString
    IDs(2) = idHType
    Defaults(2) = "Hole1"

    Names(3) = "HoleView"
    Types(3) = typeString
    IDs(3) = idHoleView
    Defaults(3) = "FrontSection"

    Names(4) = "LengthOldH"
    Types(4) = typeDouble
    IDs(4) = idLengthOld
    Defaults(4) = 3#

    Names(5) = "LengthThreadH"
    Types(5) = typeDouble
    IDs(5) = idLengthThread
    Defaults(5) = 1.5

    Names(6) = "DiameterOldH"
    Types(6) = typeDouble
    IDs(6) = idDiameterOld
    Defaults(6) = 1#

    Names(7) = "HTypeOld"
    Types(7) = typeString
    IDs(7) = idHTypeOld
    Defaults(7) = "HexBolt"

    Names(8) = "HoleViewOld"
    Types(8) = typeString
    IDs(8) = idHoleViewOld
    Defaults(8) = "FrontSection"

    Names(9) = "LengthThreadOldH"
    Types(9) = typeDouble
    IDs(9) = idLengthThreadOld
    Defaults(9) = 1.5

    Names(10) = "X0OldH"
    Types(10) = typeDouble
    IDs(10) = idX0Old
    Defaults(10) = 0#

    Names(11) = "Y0OldH"
    Types(11) = typeDouble
    IDs(11) = idY0Old
    Defaults(11) = 0#

    Names(12) = "X1OldH"
    Types(12) = typeDouble
    IDs(12) = idX1Old
    Defaults(12) = 3#

    Names(13) = "Y1OldH"
    Types(13) = typeDouble
    IDs(13) = idY1Old
    Defaults(13) = 0#

    Names(14) = "X2OldH"
    Types(14) = typeDouble
    IDs(14) = idX2Old
    Defaults(14) = 1.5

    Names(15) = "Y2OldH"
    Types(15) = typeDouble
    IDs(15) = idY2Old
    Defaults(15) = 0#

   GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmHole
    Names(0) = frmHole.Caption
    Unload frmHole

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
        GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed
        Dim Diameter#, Length#, LengthThread#
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmHole
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next
                'When the property page is closed, transfer the numeric
                'Diameter value from the TextBox to the Graphic
                'Get the value as a double-precision number
                Diameter# = CDbl(.txtdd.Text)
                Length# = CDbl(.txtLen.Text)
                LengthThread# = CDbl(.txtThread.Text)
                TypeH = .List1.Text
'                ViewH = .List2.Text
                'Make sure it's between 0 and 100
                If Diameter# < 0# Then Diameter# = 1#
                If Diameter# > 3# Then Diameter# = 3#
                If LengthThread > Length Then LengthThread = Length
                'Set the roundness property value in the Graphic
                Graphic.Properties("DiameterH") = Diameter#
                Graphic.Properties("LengthH") = Length#
                Graphic.Properties("LengthThreadH") = LengthThread#
                Graphic.Properties("HType") = TypeH
'                Graphic.Properties("HoleView") = ViewH
            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
                Diameter# = Graphic.Properties("DiameterH")
                Length# = Graphic.Properties("LengthH")
                LengthThread = Graphic.Properties("LengthThreadH")
                TypeH = Graphic.Properties("HType")
'                ViewH = Graphic.Properties("HoleView")
            Load frmHole
            With frmHole

                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                'Set the TextBox control's text
                .txtdd.Text = Diameter#
                .txtLen = Length#
                .txtThread.Text = LengthThread#
NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmHole
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmHole
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis1 As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If
Dim grfThis As Graphic
    Set grfThis = grfThis1
    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "first point of axis"
    grfThis.Vertices.Add 0#, 0, 0#, False, True, True, True, True, False

    'Second Vertex is "Second point of axis"
    grfThis.Vertices.Add 3#, 0, 0#, False, True, True, True, True, False

    'Third Vertex is "Point on theard"
    grfThis.Vertices.Add 1.5, 0, 0#, False, True, True, True, True, False

    grfThis.Properties("PenColor") = RGB(0, 0, 0)
    grfThis.Properties("BrushColor") = RGB(255, 255, 255)
    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis1 As Object)
        'Setup error handler
        On Error GoTo Failed
Dim grfThis As Graphic
        Set grfThis = grfThis1
        'Set up lock (prevent recursion)

Dim LockCount&
        LockCount& = grfThis.RegenLock

        PColor = grfThis.Properties("PenColor")
''AALB problem with load old files
' AALB try to fix bug with reading files from TC v6.5 (problem is that some sdk regens
' has Type = 7(Group, must be GRAPHIc (11))
On Error Resume Next
Err.Clear
        BColor = grfThis.Properties("BrushColor")
        If Err.Number <> 0 Then
            BColor = RGB(255, 255, 255)
            Err.Clear
        End If
        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
            grfThis.Graphics.Clear gfCosmetic

Dim dd#, ddOld#
Dim TypeHOld As String, ViewHOld As String
                dd = grfThis.Properties("DiameterH")
                ddOld = grfThis.Properties("DiameterOldH")

                TypeH = grfThis.Properties("HType")
                TypeHOld = grfThis.Properties("HTypeOld")

                ViewH = grfThis.Properties("HoleView")
                ViewHOld = grfThis.Properties("HoleViewOld")
Dim x0Old#, y0Old#, x1Old#, y1Old#, x2Old#, y2Old#
                x0Old = grfThis.Properties("x0OldH")
                y0Old = grfThis.Properties("y0OldH")
                x1Old = grfThis.Properties("x1OldH")
                y1Old = grfThis.Properties("y1OldH")
'MsgBox ("x1Old=" & CStr(x1Old) & "  y1Old=" & CStr(y1Old))
                x2Old = grfThis.Properties("x2OldH")
                y2Old = grfThis.Properties("y2OldH")

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim Salp#, Calp#, L#
Dim X00#, Y00#, X01#, Y01#, X02#, Y02#
Dim LenProp#, LenOld#
        LenProp = grfThis.Properties("LengthH")
        LenOld = grfThis.Properties("LengthOldH")
Dim LenPropThread#, LenThreadOld#
Dim LThread#

        LenPropThread = grfThis.Properties("LengthThreadH")
        LThread = LenPropThread
        LenThreadOld = grfThis.Properties("LengthThreadOldH")

        With grfThis.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            X02 = .Item(2).X
            Y02 = .Item(2).Y
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
            If Abs(L) < 0.001 Then
                X00 = x0Old
                Y00 = y0Old
                X01 = x1Old
                Y01 = y1Old
                X02 = x2Old
                Y02 = y2Old
                L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
                .Item(0).X = X00
                .Item(0).Y = Y00
                .Item(1).X = X01
                .Item(1).Y = Y01
                .Item(2).X = X02
                .Item(2).Y = Y02
            End If
            Salp = (Y01 - Y00) / L
            Calp = (X01 - X00) / L
        End With

' If there are changes in Property's Page
        If Abs(dd - ddOld) > 0.001 Or Abs(LenProp - LenOld) > 0.001 Or Abs(LenPropThread - LenThreadOld) > 0.001 Or TypeH <> TypeHOld Or ViewH <> ViewHOld Then
            If ViewH = "FrontSection" And (ViewHOld = "Front" Or ViewHOld = "Top") Then
Dim Calp2#, Salp2#
                Calp2 = Calp
                Salp2 = Salp
                Calp = Salp2
                Salp = -Calp2
                X01 = X00 + LenProp * Calp
                Y01 = Y00 + LenProp * Salp
                With grfThis.Vertices
                    .Item(1).X = X01
                    .Item(1).Y = Y01
                    L = LenProp
                End With
                X02 = X00 + (X01 - X00) * LenPropThread / LenProp
                Y02 = Y00 + (Y01 - Y00) * LenPropThread / LenProp
                With grfThis.Vertices
                    .Item(2).X = X02
                    .Item(2).Y = Y02
                End With
            End If
            If Abs(LenProp - LenOld) > 0.001 And ViewH = ViewHOld Then
                X01 = X00 + LenProp * Calp
                Y01 = Y00 + LenProp * Salp
                With grfThis.Vertices
                    .Item(1).X = X01
                    .Item(1).Y = Y01
                    L = LenProp
                End With
            End If
            If Abs(LenPropThread - LenThreadOld) > 0.001 And ViewH = ViewHOld Then
                If LenPropThread > LenProp Then
                    grfThis.Properties("LengthThreadH") = CDbl(Format(LenProp, "###0.00"))
                    LenPropThread = LenProp
                    LThread = LenPropThread
                End If
                X02 = X00 + (X01 - X00) * LenPropThread / LenProp
                Y02 = Y00 + (Y01 - Y00) * LenPropThread / LenProp
                With grfThis.Vertices
                    .Item(2).X = X02
                    .Item(2).Y = Y02
                End With
            End If
            GoTo LL
        End If

' If change location of the at least one base vertex
        If Abs(X00 - x0Old) > 0.001 Or Abs(Y00 - y0Old) > 0.001 Or Abs(X01 - x1Old) > 0.001 Or Abs(Y01 - y1Old) > 0.001 Or Abs(X02 - x2Old) > 0.001 Or Abs(Y02 - y2Old) > 0.001 Then
            If ViewH = "Front" Or ViewH = "Top" Then GoTo LL
            If Abs(X00 - x0Old) > 0.001 Or Abs(Y00 - y0Old) > 0.001 Or Abs(X01 - x1Old) > 0.001 Or Abs(Y01 - y1Old) > 0.001 Then
                grfThis.Properties("LengthH") = CDbl(Format(L, "###0.00"))
                If LThread > L Then
                    LThread = L
                    grfThis.Properties("LengthThreadH") = CDbl(Format(LThread, "###0.00"))
                End If
                X02 = X00 + (X01 - X00) * LThread / L
                Y02 = Y00 + (Y01 - Y00) * LThread / L
                With grfThis.Vertices
                    .Item(2).X = X02
                    .Item(2).Y = Y02
                End With
            End If
            If Abs(X00 - x0Old) < 0.001 And Abs(Y00 - y0Old) < 0.001 And Abs(X01 - x1Old) < 0.001 And Abs(Y01 - y1Old) < 0.001 Then
                If Abs(X02 - x2Old) > 0.001 Or Abs(Y02 - y2Old) > 0.001 Then
 Dim Salp1#, Calp1#
                    Salp1 = (Y01 - Y00) / L
                    Calp1 = (X01 - X00) / L
                    LThread = (Y02 - Y00) * Salp1 + (X02 - X00) * Calp1
                    If LThread > L Then LThread = L
                    If LThread < 0 Then LThread = 0#
                    grfThis.Properties("LengthThreadH") = CDbl(Format(LThread, "###0.00"))
                    X02 = X00 + (X01 - X00) * LThread / L
                    Y02 = Y00 + (Y01 - Y00) * LThread / L
                    With grfThis.Vertices
                        .Item(2).X = X02
                        .Item(2).Y = Y02
                    End With
                End If
            End If
        End If
LL:
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
            If TypeH = "Hole1" Then Call Hole1(grfThis, dd, L, Salp, Calp, ViewH, ViewHOld, LThread)
            If TypeH = "Hole2" Then Call Hole2(grfThis, dd, L, Salp, Calp, ViewH, ViewHOld, LThread)
            If TypeH = "Hole3" Then Call Hole3(grfThis, dd, L, Salp, Calp, ViewH, ViewHOld, LThread)
            If TypeH = "Hole4" Then Call Hole4(grfThis, dd, L, Salp, Calp, ViewH, ViewHOld, LThread)
            If TypeH = "Hole5" Then Call Hole5(grfThis, dd, L, Salp, Calp, ViewH, ViewHOld, LThread)
            'Add visible child Graphics
        End If
        grfThis.Properties("DiameterOldH") = grfThis.Properties("DiameterH")
        grfThis.Properties("LengthOldH") = grfThis.Properties("LengthH")
        grfThis.Properties("LengthThreadOldH") = grfThis.Properties("LengthThreadH")
        grfThis.Properties("HTypeOld") = TypeH
        grfThis.Properties("HoleViewOld") = ViewH
        grfThis.Properties("x0OldH") = X00
        grfThis.Properties("y0OldH") = Y00
'MsgBox ("x01=" & CStr(X01) & " y01=" & CStr(Y01))
        grfThis.Properties("x1OldH") = X01
        grfThis.Properties("y1OldH") = Y01
        grfThis.Properties("x2OldH") = X02
        grfThis.Properties("y2OldH") = Y02

        grfThis.RegenUnlock
        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:

'        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
'        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function
Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function

Private Sub Hole1(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)

Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            .Item(2).X = X01
            .Item(2).Y = Y01
            .Item(2).Selectable = False
            .Item(2).Editable = False
        End With
Dim del#
        del = 0.1 * dd

Dim X0(8)
Dim Y0(8)
Dim X(8)
Dim Y(8)
        X0(1) = 0#
        Y0(1) = dd / 2# + del

        X0(2) = X0(1)
        Y0(2) = -Y0(1)

        X0(3) = del
        Y0(3) = dd / 2#

        X0(4) = X0(3)
        Y0(4) = -Y0(3)

        X0(5) = L - del
        Y0(5) = dd / 2#

        X0(6) = X0(5)
        Y0(6) = -Y0(5)

        X0(7) = L
        Y0(7) = dd / 2 + del

        X0(8) = X0(7)
        Y0(8) = -Y0(7)

Dim i%
        For i = 1 To 8
             X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
             Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
        Next i
Dim GrChild As Graphic
            'Add child Graphics
' ##########################################################################
' ##########################################################################
        If ScrewView = "FrontSection" Then
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'           GrChild.Properties("BrushColor") = RGB(255, 255, 255)
'            GrChild.Properties("BrushColor") = BColor
            GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, False, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

        End If

End Sub

Private Sub Hole2(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)

Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            .Item(2).X = X01
            .Item(2).Y = Y01
            .Item(2).Selectable = False
            .Item(2).Editable = False
        End With
Dim del#
        del = 0.1 * dd

Dim X0(6)
Dim Y0(6)
Dim X(6)
Dim Y(6)

        X0(1) = 0#
        Y0(1) = dd / 2# + del

        X0(2) = X0(1)
        Y0(2) = -Y0(1)

        X0(3) = del
        Y0(3) = dd / 2#

        X0(4) = X0(3)
        Y0(4) = -Y0(3)

        X0(5) = L
        Y0(5) = dd / 2#

        X0(6) = X0(5)
        Y0(6) = -Y0(5)

Dim i%
        For i = 1 To 6
             X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
             Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
        Next i
Dim GrChild As Graphic
            'Add child Graphics
' ##########################################################################
' ##########################################################################
        If ScrewView = "FrontSection" Then
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

        End If

End Sub

Private Sub Hole3(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)

Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            .Item(2).Selectable = True
            .Item(2).Editable = True
        End With
Dim del#
        del = 0.1 * dd

Dim X0(8)
Dim Y0(8)
Dim X(8)
Dim Y(8)
        X0(1) = 0#
        Y0(1) = dd / 2#

        X0(2) = X0(1)
        Y0(2) = -Y0(1)

        X0(3) = del
        Y0(3) = dd / 2# - del

        X0(4) = X0(3)
        Y0(4) = -Y0(3)

        X0(5) = L
        Y0(5) = dd / 2# - del

        X0(6) = X0(5)
        Y0(6) = -Y0(5)

    '-------------------------------
        If LThread > 0 Then
            If LThread > L Then
                LThread = L
                Gr.Properties("LengthThread") = L
            End If
            X0(7) = LThread
        Else
            X0(7) = 0#
        End If
        Y0(7) = dd / 2#

        X0(8) = X0(7)
        Y0(8) = -Y0(7)

Dim i%
        For i = 1 To 8
             X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
             Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
        Next i
Dim GrChild As Graphic
            'Add child Graphics
' ##########################################################################
' ##########################################################################
        If ScrewView = "FrontSection" Then
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
        'Threading
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Properties("PenColor") = PColor

        End If

End Sub

Private Sub Hole4(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)

Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            .Item(2).Selectable = True
            .Item(2).Editable = True
        End With
Dim del#
        del = 0.1 * dd

Dim X0(9)
Dim Y0(9)
Dim X(9)
Dim Y(9)
        X0(1) = 0#
        Y0(1) = dd / 2#

        X0(2) = X0(1)
        Y0(2) = -Y0(1)

        X0(3) = del
        Y0(3) = dd / 2# - del

        X0(4) = X0(3)
        Y0(4) = -Y0(3)

        X0(5) = L
        Y0(5) = dd / 2# - del

        X0(6) = X0(5)
        Y0(6) = -Y0(5)

        X0(7) = L + dd / 2# * Tan(Pi / 6)
        Y0(7) = 0#
    '-------------------------------
        If LThread > 0 Then
            If LThread > L Then
                LThread = L
                Gr.Properties("LengthThread") = L
            End If
            X0(8) = LThread
        Else
            X0(8) = 0#
        End If
        Y0(8) = dd / 2#

        X0(9) = X0(8)
        Y0(9) = -Y0(8)

Dim i%
        For i = 1 To 9
             X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
             Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
        Next i
Dim GrChild As Graphic
            'Add child Graphics
' ##########################################################################
' ##########################################################################
        If ScrewView = "FrontSection" Then
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, False, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
        'Threading
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Properties("PenColor") = PColor

        End If

End Sub

Private Sub Hole5(Gr As Graphic, dd As Double, L As Double, Salp As Double, Calp As Double, ScrewView As String, ScrewViewOld As String, LThread As Double)

Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            .Item(2).Selectable = True
            .Item(2).Editable = True
        End With
Dim del#
        del = 0.1 * dd

Dim X0(9)
Dim Y0(9)
Dim X(9)
Dim Y(9)
        X0(1) = 0#
        Y0(1) = dd / 2#

        X0(2) = X0(1)
        Y0(2) = -Y0(1)

        X0(3) = 0#
        Y0(3) = dd / 2# - del

        X0(4) = X0(3)
        Y0(4) = -Y0(3)

        X0(5) = L
        Y0(5) = dd / 2# - del

        X0(6) = X0(5)
        Y0(6) = -Y0(5)

        X0(7) = L + dd / 2# * Tan(Pi / 6)
        Y0(7) = 0#
    '-------------------------------
        If LThread > 0 Then
            If LThread > L Then
                LThread = L
                Gr.Properties("LengthThread") = L
            End If
            X0(8) = LThread
        Else
            X0(8) = 0#
        End If
        Y0(8) = dd / 2#

        X0(9) = X0(8)
        Y0(9) = -Y0(8)

Dim i%
        For i = 1 To 9
             X(i) = X00 + X0(i) * Calp - Y0(i) * Salp
             Y(i) = Y00 + X0(i) * Salp + Y0(i) * Calp
        Next i
Dim GrChild As Graphic
            'Add child Graphics
' ##########################################################################
' ##########################################################################
        If ScrewView = "FrontSection" Then
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, False, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
        'Threading
            Set GrChild = Gr.Graphics.Add(gkGraphic)
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(9), Y(9), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
            End With
            GrChild.Cosmetic = True
            GrChild.Properties("PenColor") = PColor

        End If

End Sub


Examples - 3D Nut Regen - Nut3.bas

Nut3.bas

3D Nut Regen Example

Attribute VB_Name = "modNut3"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
Global Const Pi = 3.14159
Global TypeN As String
' DLL Entry point
Sub Main()

End Sub


Examples - 3D Nut Regen - Nut3.cls

Nut3.cls

3D Nut Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Detail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265
Const Eps = 0.0001

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idNutType = 1
Const idDiameter = 2
Const idSolid = 3

Const idNutTypeOld = 4
Const idDiameterOld = 5
Const idSolidOld = 6

Const idHOld = 7

'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 7
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "SDK Nut3D"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{FDB6F1C3-9631-11d1-A40A-0000B465872B}"

End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
    Names(0) = "NutType"
    Types(0) = typeString
    IDs(0) = idNutType
    Defaults(0) = "HexNut"

    Names(1) = "Diameter"
    Types(1) = typeDouble
    IDs(1) = idDiameter
    Defaults(1) = 1#

    Names(2) = "NutSolid"
    Types(2) = typeInteger
    IDs(2) = idSolid
    Defaults(2) = 0

    Names(3) = "NutTypeOld"
    Types(3) = typeString
    IDs(3) = idNutTypeOld
    Defaults(3) = "HexNut"

    Names(4) = "DiameterOld"
    Types(4) = typeDouble
    IDs(4) = idDiameterOld
    Defaults(4) = 1.5

    Names(5) = "NutSolidOld"
    Types(5) = typeInteger
    IDs(5) = idSolidOld
    Defaults(5) = 0

    Names(6) = "HOld"
    Types(6) = typeDouble
    IDs(6) = idHOld
    Defaults(6) = 0#

   GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmNut3
    Names(0) = frmNut3.Caption
    Unload frmNut3

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long

End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed
        Dim i%
        Dim Diameter#
        Dim SSolid%
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmNut3
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next
                'When the property page is closed, transfer the numeric
                'Diameter value from the TextBox to the Graphic
                'Get the value as a double-precision number
                TypeN = .List1.Text
                Diameter# = CDbl(.txtdd.Text)
'                SSolid = .Surf_Solid.Value
                 If .Surf_Solid.Value = True Then
                    SSolid = False
                 ElseIf .Surf_Solid1.Value = True Then
                    SSolid = True
                 End If

                'Set the property values in the Graphic
                Graphic.Properties("Diameter") = Diameter#
                Graphic.Properties("NutType") = TypeN
                Graphic.Properties("NutSolid") = SSolid

            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmNut3
            With frmNut3

                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                'roundness value from the Graphic to the TextBox
                'Get the roundness property value from the Graphic
                Diameter# = Graphic.Properties("Diameter")
                TypeN = Graphic.Properties("NutType")
                SSolid = Graphic.Properties("NutSolid")
            'Set the TextBox control's text
                .txtdd.Text = Diameter#
                .List1.Text = TypeN
'                .Surf_Solid.Value = SSolid
                 If SSolid = True Then
                    .Surf_Solid1.Value = True
                    .Surf_Solid.Value = False
                 ElseIf SSolid = False Then
                    .Surf_Solid1.Value = False
                    .Surf_Solid.Value = True
                 End If

NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmNut3
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmNut3
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis1 As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If
Dim grfThis As Graphic
    Set grfThis = grfThis1
    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "first point of axis"
'    grfThis.Vertices.UseWorldCS = True
    grfThis.Vertices.Add 3#, 5#, 0#, False, True, True, False, False, True

    'Second Vertex is "Second point of axis"
    grfThis.Vertices.Add 4#, 5#, 0#, False, True, True, False, False, True
'    grfThis.Properties("PenWidth") = 0.04
    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis1 As Object)
'Setup error handler
'MsgBox ("Regen")
        On Error GoTo Failed
Dim grfThis As Graphic
        Set grfThis = grfThis1
        'Set up lock (prevent recursion)
        Dim LockCount&
        LockCount& = grfThis.RegenLock
        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
Dim TypeNn As String
            'Delete any previous cosmetic children
            TypeNn = grfThis.Properties("NutType")
Dim TypeNOld$
            TypeNOld = grfThis.Properties("NutTypeOld")
Dim dd#, ddOld#
            dd = grfThis.Properties("Diameter")
            ddOld = grfThis.Properties("DiameterOld")
Dim NSolid%, NSolidOld%
            NSolid = grfThis.Properties("NutSolid")
            NSolidOld = grfThis.Properties("NutSolidOld")
Dim Salp#, Calp#, L#
Dim X00#, Y00#, Z00#, X01#, Y01#, Z01#
            grfThis.Vertices.UseWorldCS = True
            With grfThis.Vertices
                X00 = .Item(0).X
                Y00 = .Item(0).Y
                Z00 = .Item(0).Z
                X01 = .Item(1).X
                Y01 = .Item(1).Y
                Z01 = .Item(1).Z
            End With
'MsgBox ("Regen x00=" & CStr(X00) & " y00=" & CStr(Y00) & " z00=" & CStr(Z00))

'Block to snap to Bolt's axis
Dim GrSet As GraphicSet
Dim CountGr As Long
Dim i As Long
Dim Gr1 As Graphic
Dim X10#, Y10#, Z10#, X11#, Y11#, Z11#
            Set GrSet = grfThis.Drawing.Graphics.QuerySet("Type=SDK_Bolt_Screw")
            CountGr = GrSet.Count
            For i = 0 To CountGr - 1
                Set Gr1 = GrSet(i)
                If Gr1.Type = "HexBolt3D.Detail" Then
                    Gr1.Vertices.UseWorldCS = True
                    With Gr1.Vertices
                        X10 = .Item(0).X
                        Y10 = .Item(0).Y
                        Z10 = .Item(0).Z
                        X11 = .Item(1).X
                        Y11 = .Item(1).Y
                        Z11 = .Item(1).Z
                    End With
Dim s#
                    s = DistPointLine(X00, Y00, Z00, X10, Y10, Z10, X11, Y11, Z11)
'MsgBox ("s=" & CStr(s))
                    If Abs(s) < -0.1 Then
Dim hNut#, lBolt#, lBoltNut#
                        hNut = grfThis.Properties("HOld")
                        lBolt = Sqr((X11 - X10) * (X11 - X10) + (Y11 - Y10) * (Y11 - Y10) + (Z11 - Z10) * (Z11 - Z10))
'MsgBox ("s=" & CStr(s) & "  hNut=" & CStr(hNut) & " lBolt=" & CStr(lBolt))
                        lBoltNut = Sqr((X00 - X10) * (X00 - X10) + (Y00 - Y10) * (Y00 - Y10) + (Z00 - Z10) * (Z00 - Z10))
                        If hNut < Eps Or lBoltNut < Eps Then
                            Exit For
                        End If
Dim X00New#, Y00New#, Z00New#, X01New#, Y01New#, Z01New#
                        X00New = X10 + (X11 - X10) * lBoltNut / lBolt
                        Y00New = Y10 + (Y11 - Y10) * lBoltNut / lBolt
                        Z00New = Z10 + (Z11 - Z10) * lBoltNut / lBolt
                        X01New = X00New + (X11 - X10) * hNut / lBolt
                        Y01New = Y00New + (Y11 - Y10) * hNut / lBolt
                        Z01New = Z00New + (Z11 - Z10) * hNut / lBolt
                        grfThis.MoveRelative X00New - X00, Y00New - Y00, Z00New - Z00
Dim xTo#, yTo#, zTo#
Dim xFrom#, yFrom#, zFrom#
Dim xRef#, yRef#, zRef#

                        xRef = X00New
                        yRef = Y00New
                        zRef = Z00New

                        xTo = X00New + (X01 - X00) / hNut
                        yTo = Y00New + (Y01 - Y00) / hNut
                        zTo = Z00New + (Z01 - Z00) / hNut

                        xFrom = X00New + (X01New - X00New) / hNut
                        yFrom = Y00New + (Y01New - Y00New) / hNut
                        zFrom = Z00New + (Z01New - Z00New) / hNut
                        grfThis.RotateAbsolute xTo, yTo, zTo, xFrom, yFrom, zFrom, xRef, yRef, zRef
                        Salp = (Y01 - Y00) / hNut
                        Calp = (X01 - X00) / hNut
Dim beta#
                        beta = Angle(Salp, Calp)
'MsgBox ("Beta=" & CStr(beta * 180 / Pi))
 '                      grfThis.RotateAxis -beta, 0, 0, 1, xRef, yRef, zRef

                       Exit For
                    End If
                End If
            Next i
            Set Gr1 = Nothing
            Set GrSet = Nothing
'                L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00))
            Salp = (Y01 - Y00) / L
            Calp = (X01 - X00) / L
 Dim HOld#
            HOld = grfThis.Properties("HOld")

'##########################################################
'            TypeN = "HexNut"
'            grfThis.Properties("NutType") = "HexNut"
Dim CountCosm As Long, iCosm As Long
            CountCosm = grfThis.Graphics.Count
            If CountCosm > 1 Then
                For iCosm = 1 To CountCosm - 1
                    grfThis.Graphics(iCosm).Properties("PenColor") = grfThis.Properties("PenColor")
                Next iCosm
            End If
            If grfThis.Properties("Selected") = False Or Abs(L - HOld) > Eps Or CountCosm < 2 Or NSolid <> NSolidOld Or Abs(dd - ddOld) > Eps Or TypeNn <> TypeNOld Then
                grfThis.Graphics.Clear gfCosmetic
'MsgBox ("1111")
' Block for Scaling
Dim AddScale#
                AddScale = 1
'                AddScale = 1# / dd
                dd = dd * AddScale

                If TypeNn = "HexNut" Then
                    Call HexNut(grfThis, dd, Salp, Calp, NSolid, AddScale)
'MsgBox ("222")
                End If

    '            If TypeN = "HexFlangeNut" Then
    '                Call HexFlangeNut(grfThis, dd)
    '            End If

                If TypeNn = "HexSlottedNut" Then
                    Call HexSlottedNut(grfThis, dd, Salp, Calp, NSolid, AddScale)
                End If

                If TypeNn = "LowCrownNut" Then
                    Call LowCrownNut(grfThis, dd, Salp, Calp, NSolid, AddScale)
                End If

    '            If TypeN = "SquareNut" Then
    '                Call SquareNut(grfThis, dd)
    '            End If
' Block for Unscaling
                dd = dd / AddScale
'Dim Matr As Matrix
'                Set Matr = grfThis.Scale(1# / AddScale, 1# / AddScale, 1# / AddScale, X00, Y00, Z00)

                grfThis.Properties("DiameterOld") = dd
                grfThis.Properties("NutTypeOld") = TypeNn
                grfThis.Properties("NutSolidOld") = NSolid

                grfThis.Vertices.UseWorldCS = True
                With grfThis.Vertices
                    X00 = .Item(0).X
                    Y00 = .Item(0).Y
                    Z00 = .Item(0).Z
                    X01 = .Item(1).X
                    Y01 = .Item(1).Y
                    Z01 = .Item(1).Z
'                    L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
                    L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00))
                End With
                grfThis.Properties("HOld") = L
            End If
            'Add visible child Graphics
        End If
        grfThis.RegenUnlock
        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:

        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function
Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function

' HexNut

Private Sub HexNut(Gr As Graphic, dd As Double, Salp As Double, Calp As Double, SSolid As Integer, AddScale As Double)
On Error GoTo Failed
Dim Grs As Graphics
    Set Grs = Gr.Drawing.Graphics
Dim D#, H#, s#, del#
        D = 1.84 * dd
        H = 0.7 * dd
        s = D * Cos(Pi / 6)
        del = 0.1 * dd

        Gr.Vertices.UseWorldCS = True

Dim X00#, Y00#, Z00#, X01#, Y01#, Z01#, L#

        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            Z00 = .Item(0).Z
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            Z01 = .Item(1).Z
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00)) '!!!!!!!
            .Item(1).X = X00 + (X01 - X00) * H / AddScale / L
            .Item(1).Y = Y00 + (Y01 - Y00) * H / AddScale / L
            .Item(1).Z = Z00 + (Z01 - Z00) * H / AddScale / L
'            .Item(1).Z=0
            X01 = X00 + (X01 - X00) * H / L '!!!!!!!
            Y01 = Y00 + (Y01 - Y00) * H / L '!!!!!!!
            Z01 = Z00 + (Z01 - Z00) * H / L '!!!!!!!
        End With

Dim X00New#, Y00New#, Z00New#, X01New#, Y01New#, Z01New#
        X00New = X00    '!!!!!!!
        Y00New = Y00    '!!!!!!!
        Z00New = Z00    '!!!!!!!
        X01New = X01    '!!!!!!!
        Y01New = Y01    '!!!!!!!
        Z01New = Z01    '!!!!!!!
        X00 = 0#    '!!!!!!!
        Y00 = 0#    '!!!!!!!
        Z00 = 0#    '!!!!!!!
        X01 = H    '!!!!!!!
        Y01 = 0#    '!!!!!!!
        Z01 = 0#    '!!!!!!!

Dim x0(100)
Dim y0(100)
Dim X(100)
Dim Y(100)

Dim i As Long
' Head of the bolt
    For i = 7 To 13
        x0(i) = D / 2 * Cos(Pi / 3 * (i - 7))
        y0(i) = D / 2 * Sin(Pi / 3 * (i - 7))
    Next i
Dim Gr1 As Graphic
Set Gr1 = Grs.Add(gkGraphic)
Gr1.Vertices.UseWorldCS = True
With Gr1.Vertices
    For i = 7 To 13
        .Add x0(i), y0(i), 0, True, True, False, False, False, False
    Next i
End With
Gr1.Closed = True
Gr1.Properties("Thickness") = H
Gr1.Properties("Solid") = SSolid
Dim xTo#, yTo#, zTo#, xFrom#, yFrom#, zFrom#, xRef#, yRef#, zRef#
    xTo = X00 + (X01 - X00) / H
    yTo = Y00 + (Y01 - Y00) / H
    zTo = 0
    xFrom = X00
    yFrom = Y00
    zFrom = -1#
    xRef = X00
    yRef = Y00
    zRef = 0#
    Gr1.RotateAbsolute xTo, yTo, zTo, xFrom, yFrom, zFrom, xRef, yRef, zRef
'################################################################
'################################################################
Dim T#
    T = D / 2 * Sin(Pi / 3)
       x0(1) = -0.1 * H
       y0(1) = T * 0.7 - 0.1 * H / Tan(Pi / 6)

       x0(2) = -0.1 * H
       y0(2) = D

       x0(3) = 0.4 * H
       y0(3) = D

       x0(4) = 0.4 * H
       y0(4) = T * 0.7 + 0.5 * H / Tan(Pi / 6)

       x0(5) = x0(1)
       y0(5) = y0(1)

'-----------------------------------------------------------

Dim GrTemp As Graphic
            Set GrTemp = Grs.Add(gkGraphic)
GrTemp.Vertices.UseWorldCS = True
            With GrTemp.Vertices
                For i = 1 To 5
                    .Add x0(i), y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
Dim Gr2 As Graphic '1 faska
            Set Gr2 = Grs.Add(, "TCW40SPIN")
Gr2.Vertices.UseWorldCS = True
            Gr2.Properties("Solid") = SSolid
            Gr2.Properties("$ROTATIONANGLE") = 360#
            Gr2.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr2.Graphics.AddGraphic GrTemp
            Gr2.Vertices.Add X00, Y00, 0, False, False, False, False, False
            Gr2.Vertices.Add X01, Y01, 0, False, False, False, False, False
Dim Gr3 As Graphic ' 2 faska
            Set Gr3 = Gr2.Duplicate
            Gr3.RotateAxis Pi, 0, 0, 1, X00, Y00, Z00
            Gr3.MoveRelative H, 0, 0

' Internal Hole
       x0(1) = -del
       y0(1) = 0#

       x0(2) = -del
       y0(2) = dd / 2 + del

       x0(3) = del
       y0(3) = dd / 2 - del

       x0(4) = H - del
       y0(4) = dd / 2 - del

       x0(5) = H + del
       y0(5) = dd / 2 + del

       x0(6) = H + del
       y0(6) = 0

       x0(7) = x0(1)
       y0(7) = y0(1)

'-----------------------------------------------------------

            Set GrTemp = Grs.Add(gkGraphic)
GrTemp.Vertices.UseWorldCS = True
            With GrTemp.Vertices
                For i = 1 To 7
                    .Add x0(i), y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
Dim Gr4 As Graphic
            Set Gr4 = Grs.Add(, "TCW40SPIN")
Gr4.Vertices.UseWorldCS = True
            Gr4.Properties("Solid") = SSolid
            Gr4.Properties("$ROTATIONANGLE") = 360#
            Gr4.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr4.Graphics.AddGraphic GrTemp
            Gr4.Vertices.Add X00, Y00, 0, False, False, False, False, False
            Gr4.Vertices.Add X01, Y01, 0, False, False, False, False, False

' Thread
    'Base contour
Dim hThread# ' Step of the thread
    hThread = del / Sin(Pi / 3)
Dim nCoil As Long ', K As Long
    nCoil = 10
    nCoil = CLng(H / hThread) + 1
Dim lThread#
    lThread = nCoil * hThread
Dim k As Long

    x0(1) = 0#
    y0(1) = 0#

    x0(2) = 0#
    y0(2) = dd / 2 - del

    k = 2

    For i = 1 To nCoil
        k = k + 1
        x0(k) = x0(k - 1) + hThread / 2
        y0(k) = y0(k - 1) + del
        k = k + 1
        x0(k) = x0(k - 1) + hThread / 2
        y0(k) = y0(k - 1) - del
    Next i
    k = k + 1
    x0(k) = lThread
    y0(k) = 0

    k = k + 1
    x0(k) = 0
    y0(k) = 0

'    x0(1) = -hThread
'    y0(1) = dd / 2 - 2# * del

'    x0(2) = -hThread
'    y0(2) = dd / 2 - 1.1 * del

'    x0(3) = -hThread / 2
'    y0(3) = dd / 2

'    x0(4) = 0#
'    y0(4) = dd / 2 - 1.1 * del

'    x0(5) = 0#
'    y0(5) = dd / 2 - 2# * del

'    x0(6) = x0(1)
'    y0(6) = y0(1)

Set GrTemp = Grs.Add(gkGraphic)
GrTemp.Vertices.UseWorldCS = True
With GrTemp.Vertices
    For i = 1 To k '6
        .Add x0(i), y0(i), 0
    Next i
End With
GrTemp.Closed = True

Dim Gr5 As Graphic
Set Gr5 = Grs.Add(, "TCW40SPIN")
Gr5.Vertices.UseWorldCS = True
Gr5.Properties("Solid") = SSolid
Gr5.Properties("$ROTATIONANGLE") = 360#
'Gr5.Properties("$SPIRENUMBER") = nCoil
'Gr5.Properties("$STEP") = 1.05 * hThread  '1.015
Gr5.Properties("$ROTATIONCOPY") = 30
Set GrTemp = Grs.Remove(GrTemp.Index)
Gr5.Graphics.AddGraphic GrTemp
Gr5.Vertices.Add X00, Y00, 0, False, False, False, False, False
Gr5.Vertices.Add X01, Y01, 0, False, False, False, False, False

'#################################################################
'################################################################
Dim Bool3D As Boolean3D
Dim GrRes1 As Graphic
Dim Res As Long
Dim GrIndex As Long
    Set Bool3D = New Boolean3D
    Res = 1
    Gr1.Update
    Gr2.Update
    Set GrRes1 = Bool3D.Subtract(Gr1, Gr2, Res)
    If Res = 0 Then
        Gr1.Deleted = True
        Gr2.Deleted = True
        Grs.AddGraphic GrRes1
    Else
        GrIndex = Gr2.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr2
        Gr2.Cosmetic = True
        Set GrRes1 = Gr1
    End If
Dim GrRes2 As Graphic
    GrRes1.Update
    Gr3.Update
    Set GrRes2 = Bool3D.Subtract(GrRes1, Gr3, Res)
    If Res = 0 Then
        GrRes1.Deleted = True
        Gr3.Deleted = True
        Grs.AddGraphic GrRes2
    Else
        GrIndex = Gr3.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr3
        Gr3.Cosmetic = True
        Set GrRes2 = GrRes1
    End If

Dim GrRes3 As Graphic
    GrRes2.Update
    Gr4.Update
    Set GrRes3 = Bool3D.Subtract(GrRes2, Gr4, Res)
    If Res = 0 Then
        GrRes2.Deleted = True
        Gr4.Deleted = True
        Grs.AddGraphic GrRes3
    Else
        GrIndex = Gr4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr4
        Gr4.Cosmetic = True
        Set GrRes3 = GrRes2
    End If

Dim GrRes4 As Graphic
    GrRes3.Update
    Gr5.Update
    Set GrRes4 = Bool3D.Subtract(GrRes3, Gr5, Res)
    If Res = 0 Then
        GrRes3.Deleted = True
        Gr5.Deleted = True
        Grs.AddGraphic GrRes4
Dim Matr As Matrix
'        Set Matr = GrRes4.Scale(1# / AddScale, 1# / AddScale, 1# / AddScale, X00, Y00, Z00)
 '       GrRes4.MoveRelative X00New, Y00New, Z00New '!!!!!!!

        GrIndex = GrRes4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrRes4
        GrRes4.Cosmetic = True
        GrRes4.Properties("PenColor") = Gr.Properties("PenColor")

'????????????????????????????????????????????????????????????????
Dim GrLine As Graphic
        Set GrLine = Grs.Add(11)
        GrLine.Vertices.UseWorldCS = True
        With GrLine.Vertices
            .Add 0, 0, 0
            .Add H, 0, 0
        End With
'        GrLine.Properties("PenColor") = RGB(255, 0, 0)
'        GrLine.Properties("PenWidth") = 0.03
        GrIndex = GrLine.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrLine
        GrLine.Cosmetic = True
Dim xx0#, yy0#, zz0#, xx1#, yy1#, zz1#
        GrLine.Vertices.UseWorldCS = False
        With GrLine.Vertices
            xx0 = .Item(0).X
            yy0 = .Item(0).Y
            zz0 = .Item(0).Z
            xx1 = .Item(1).X
            yy1 = .Item(1).Y
            zz1 = .Item(1).Z
        End With
         Gr.Vertices.UseWorldCS = False
        With Gr.Vertices
            X00New = .Item(0).X
            Y00New = .Item(0).Y
            Z00New = .Item(0).Z
        End With
'        GrLine.MoveRelative X00New - xx0, Y00New - yy0, Z00New - zz0  '!!!!!!!
        GrRes4.MoveRelative X00New - xx0, Y00New - yy0, Z00New - zz0 '!!!!!!!
        GrLine.Deleted = True
'????????????????????????????????????????????????????????????????

    Else
        GrIndex = Gr5.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr5
        Gr5.Cosmetic = True

        Set GrRes4 = GrRes3
        GrIndex = GrRes4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrRes4
        GrRes4.Cosmetic = True

    End If

    Set Gr1 = Nothing
    Set Gr2 = Nothing
    Set Gr3 = Nothing
    Set Gr4 = Nothing
    Set Gr5 = Nothing
    Set GrRes1 = Nothing
    Set GrRes2 = Nothing
    Set GrRes3 = Nothing
    Set GrRes4 = Nothing
    Set GrTemp = Nothing
    Set Grs = Nothing
    Set Bool3D = Nothing

Exit Sub
Failed:

        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If
End Sub

' HexSlottedNut

Private Sub HexSlottedNut(Gr As Graphic, dd As Double, Salp As Double, Calp As Double, SSolid As Integer, AddScale As Double)
On Error GoTo Failed
Dim Grs As Graphics
    Set Grs = Gr.Drawing.Graphics
Dim D#, H#, s#, del#
        D = 1.84 * dd
        H = 1# * dd
        s = D * Cos(Pi / 6)
        del = 0.1 * dd
Dim J#
        J = 0.2 * dd
        Gr.Vertices.UseWorldCS = True

Dim X00#, Y00#, Z00#, X01#, Y01#, Z01#, L#

       With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            Z00 = .Item(0).Z
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            Z01 = .Item(1).Z
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00)) '!!!!!!!
            .Item(1).X = X00 + (X01 - X00) * H / AddScale / L
            .Item(1).Y = Y00 + (Y01 - Y00) * H / AddScale / L
            .Item(1).Z = Z00 + (Z01 - Z00) * H / AddScale / L
            X01 = X00 + (X01 - X00) * H / L '!!!!!!!
            Y01 = Y00 + (Y01 - Y00) * H / L '!!!!!!!
            Z01 = Z00 + (Z01 - Z00) * H / L '!!!!!!!
        End With

Dim X00New#, Y00New#, Z00New#, X01New#, Y01New#, Z01New#
        X00New = X00    '!!!!!!!
        Y00New = Y00    '!!!!!!!
        Z00New = Z00    '!!!!!!!
        X01New = X01    '!!!!!!!
        Y01New = Y01    '!!!!!!!
        Z01New = Z01    '!!!!!!!
        X00 = 0#    '!!!!!!!
        Y00 = 0#    '!!!!!!!
        Z00 = 0#    '!!!!!!!
        X01 = H    '!!!!!!!
        Y01 = 0#    '!!!!!!!
        Z01 = 0#    '!!!!!!!

Dim x0(100)
Dim y0(100)
Dim X(100)
Dim Y(100)

Dim i As Long
' Head of the bolt
    For i = 7 To 13
        x0(i) = D / 2 * Cos(Pi / 3 * (i - 7))
        y0(i) = D / 2 * Sin(Pi / 3 * (i - 7))
    Next i
Dim Gr1 As Graphic
Set Gr1 = Grs.Add(gkGraphic)
Gr1.Vertices.UseWorldCS = True
With Gr1.Vertices
    For i = 7 To 13
        .Add x0(i), y0(i), 0, True, True, False, False, False, False
    Next i
End With
Gr1.Closed = True
Gr1.Properties("Thickness") = H
Gr1.Properties("Solid") = SSolid
Dim xTo#, yTo#, zTo#, xFrom#, yFrom#, zFrom#, xRef#, yRef#, zRef#
    xTo = X00 + (X01 - X00) / H
    yTo = Y00 + (Y01 - Y00) / H
    zTo = 0
    xFrom = X00
    yFrom = Y00
    zFrom = -1#
    xRef = X00
    yRef = Y00
    zRef = 0#
    Gr1.RotateAbsolute xTo, yTo, zTo, xFrom, yFrom, zFrom, xRef, yRef, zRef
'################################################################
'################################################################
Dim T#
    T = D / 2 * Sin(Pi / 3)
       x0(1) = -0.1 * H
       y0(1) = T * 0.7 - 0.1 * H / Tan(Pi / 6)

       x0(2) = -0.1 * H
       y0(2) = D

       x0(3) = 0.4 * H
       y0(3) = D

       x0(4) = 0.4 * H
       y0(4) = T * 0.7 + 0.5 * H / Tan(Pi / 6)

       x0(5) = x0(1)
       y0(5) = y0(1)

'-----------------------------------------------------------

Dim GrTemp As Graphic
            Set GrTemp = Grs.Add(gkGraphic)
            GrTemp.Vertices.UseWorldCS = True
            With GrTemp.Vertices
                For i = 1 To 5
                    .Add x0(i), y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
Dim Gr2 As Graphic '1 faska
            Set Gr2 = Grs.Add(, "TCW40SPIN")
            Gr2.Vertices.UseWorldCS = True
            Gr2.Properties("Solid") = SSolid
            Gr2.Properties("$ROTATIONANGLE") = 360#
            Gr2.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr2.Graphics.AddGraphic GrTemp
            Gr2.Vertices.Add X00, Y00, 0, False, False, False, False, False
            Gr2.Vertices.Add X01, Y01, 0, False, False, False, False, False
Dim Gr3 As Graphic ' 2 faska
            Set Gr3 = Gr2.Duplicate
            Gr3.RotateAxis Pi, 0, 0, 1, X00, Y00, Z00
            Gr3.MoveRelative H, 0, 0

' Internal Hole
       x0(1) = -del
       y0(1) = 0#

       x0(2) = -del
       y0(2) = dd / 2 + del

       x0(3) = del
       y0(3) = dd / 2 - del

       x0(4) = H - del
       y0(4) = dd / 2 - del

       x0(5) = H + del
       y0(5) = dd / 2 + del

       x0(6) = H + del
       y0(6) = 0

       x0(7) = x0(1)
       y0(7) = y0(1)

'-----------------------------------------------------------

            Set GrTemp = Grs.Add(gkGraphic)
            GrTemp.Vertices.UseWorldCS = True
            With GrTemp.Vertices
                For i = 1 To 7
                    .Add x0(i), y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
Dim Gr4 As Graphic
            Set Gr4 = Grs.Add(, "TCW40SPIN")
            Gr4.Vertices.UseWorldCS = True
            Gr4.Properties("Solid") = SSolid
            Gr4.Properties("$ROTATIONANGLE") = 360#
            Gr4.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr4.Graphics.AddGraphic GrTemp
            Gr4.Vertices.Add X00, Y00, 0, False, False, False, False, False
            Gr4.Vertices.Add X01, Y01, 0, False, False, False, False, False

' Thread
    'Base contour
Dim hThread# ' Step of the thread
    hThread = del / Sin(Pi / 3)
Dim nCoil As Long ', K As Long
    nCoil = 10
    nCoil = CLng(H / hThread) + 2

'    x0(1) = -hThread
'    y0(1) = dd / 2 - 2# * del

'    x0(2) = -hThread
'    y0(2) = dd / 2 - 1.1 * del

'    x0(3) = -hThread / 2
'    y0(3) = dd / 2

'    x0(4) = 0#
'    y0(4) = dd / 2 - 1.1 * del

'    x0(5) = 0#
'    y0(5) = dd / 2 - 2# * del

'    x0(6) = x0(1)
'    y0(6) = y0(1)

Dim lThread#
    lThread = nCoil * hThread
Dim k As Long

    x0(1) = 0#
    y0(1) = 0#

    x0(2) = 0#
    y0(2) = dd / 2 - del

    k = 2

    For i = 1 To nCoil
        k = k + 1
        x0(k) = x0(k - 1) + hThread / 2
        y0(k) = y0(k - 1) + del
        k = k + 1
        x0(k) = x0(k - 1) + hThread / 2
        y0(k) = y0(k - 1) - del
    Next i
    k = k + 1
    x0(k) = lThread
    y0(k) = 0

    k = k + 1
    x0(k) = 0
    y0(k) = 0

Set GrTemp = Grs.Add(gkGraphic)
GrTemp.Vertices.UseWorldCS = True
With GrTemp.Vertices
    For i = 1 To k '6
        .Add x0(i), y0(i), 0
    Next i
End With
GrTemp.Closed = True

Dim Gr5 As Graphic
Set Gr5 = Grs.Add(, "TCW40SPIN")
Gr5.Vertices.UseWorldCS = True
Gr5.Properties("Solid") = SSolid
Gr5.Properties("$ROTATIONANGLE") = 360#
'Gr5.Properties("$SPIRENUMBER") = nCoil
'Gr5.Properties("$STEP") = 1.05 * hThread  '1.015
Gr5.Properties("$ROTATIONCOPY") = 30
Set GrTemp = Grs.Remove(GrTemp.Index)
Gr5.Graphics.AddGraphic GrTemp
Gr5.Vertices.Add X00, Y00, 0, False, False, False, False, False
Gr5.Vertices.Add X01, Y01, 0, False, False, False, False, False

' First Slot
Dim fi#, dfi#
    dfi = Pi / 10#
    x0(1) = H + 0.1 * J
    y0(1) = -J / 2

    x0(2) = H + 0.1 * J
    y0(2) = J / 2

    x0(3) = x0(1) - J
    y0(3) = J / 2

    For i = 1 To 9
        x0(i + 3) = x0(3) + J / 2 * Cos(Pi / 2# + i * dfi)
        y0(i + 3) = J / 2 * Sin(Pi / 2# - i * dfi)
    Next i

    x0(13) = x0(3)
    y0(13) = -J / 2

    x0(14) = x0(1)
    y0(14) = y0(1)

Dim Gr6 As Graphic
    Set Gr6 = Grs.Add(gkGraphic)
    Gr6.Vertices.UseWorldCS = True
    With Gr6.Vertices
        For i = 1 To 14
            .Add x0(i), y0(i), 0, True, True, False, False, False, False
        Next i
    End With
    Gr6.Closed = True
    Gr6.MoveRelative 0, 0, -D
    Gr6.Properties("Thickness") = 2 * D
    Gr6.Properties("Solid") = SSolid

Dim dx#, dy#
    L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00))
    dx = (X01 - X00) / L
    dy = (Y01 - Y00) / L
    Gr6.RotateAxis Pi / 6, dx, dy, 0, X00, Y00, Z00

Dim Gr7 As Graphic
    Set Gr7 = Gr6.Duplicate
    Gr7.RotateAxis Pi / 3, dx, dy, 0, X00, Y00, Z00

Dim Gr8 As Graphic
    Set Gr8 = Gr7.Duplicate
    Gr8.RotateAxis Pi / 3, dx, dy, 0, X00, Y00, Z00

'#################################################################
'################################################################
Dim Bool3D As Boolean3D
Dim GrRes1 As Graphic
Dim Res As Long
Dim GrIndex As Long
    Set Bool3D = New Boolean3D
    Res = 1
    Gr1.Update
    Gr2.Update
    Set GrRes1 = Bool3D.Subtract(Gr1, Gr2, Res)
    If Res = 0 Then
        Gr1.Deleted = True
        Gr2.Deleted = True
        Grs.AddGraphic GrRes1
    Else
        GrIndex = Gr2.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr2
        Gr2.Cosmetic = True
        Set GrRes1 = Gr1
    End If
Dim GrRes2 As Graphic
    GrRes1.Update
    Gr3.Update
    Set GrRes2 = Bool3D.Subtract(GrRes1, Gr3, Res)
    If Res = 0 Then
        GrRes1.Deleted = True
        Gr3.Deleted = True
        Grs.AddGraphic GrRes2
    Else
        GrIndex = Gr3.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr3
        Gr3.Cosmetic = True
        Set GrRes2 = GrRes1
    End If

Dim GrRes3 As Graphic
    GrRes2.Update
    Gr4.Update
    Set GrRes3 = Bool3D.Subtract(GrRes2, Gr4, Res)
    If Res = 0 Then
        GrRes2.Deleted = True
        Gr4.Deleted = True
        Grs.AddGraphic GrRes3
    Else
        GrIndex = Gr4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr4
        Gr4.Cosmetic = True
        Set GrRes3 = GrRes2
    End If

' Work with slots
Dim GrRes5 As Graphic
    GrRes3.Update
    Gr6.Update
    Set GrRes5 = Bool3D.Subtract(GrRes3, Gr6, Res)
    If Res = 0 Then
        GrRes3.Deleted = True
        Gr6.Deleted = True
        Grs.AddGraphic GrRes5
    Else
        GrIndex = Gr6.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr6
        Gr6.Cosmetic = True
        Set GrRes5 = GrRes3
    End If

Dim GrRes6 As Graphic
    GrRes5.Update
    Gr7.Update
    Set GrRes6 = Bool3D.Subtract(GrRes5, Gr7, Res)
    If Res = 0 Then
        GrRes5.Deleted = True
        Gr7.Deleted = True
        Grs.AddGraphic GrRes6
    Else
        GrIndex = Gr7.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr7
        Gr7.Cosmetic = True
        Set GrRes6 = GrRes5
    End If

Dim GrRes7 As Graphic
    GrRes6.Update
    Gr8.Update
    Set GrRes7 = Bool3D.Subtract(GrRes6, Gr8, Res)
    If Res = 0 Then
        GrRes6.Deleted = True
        Gr8.Deleted = True
        Grs.AddGraphic GrRes7
    Else
        GrIndex = Gr8.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr8
        Gr8.Cosmetic = True
        Set GrRes7 = GrRes6
    End If

' End with slots
Dim GrRes4 As Graphic
    GrRes7.Update
    Gr5.Update
    Set GrRes4 = Bool3D.Subtract(GrRes7, Gr5, Res)
    If Res = 0 Then
        GrRes7.Deleted = True
        Gr5.Deleted = True
        Grs.AddGraphic GrRes4
Dim Matr As Matrix
'        Set Matr = GrRes4.Scale(1# / AddScale, 1# / AddScale, 1# / AddScale, X00, Y00, Z00)
'        GrRes4.MoveRelative 3, 5, 0
        GrIndex = GrRes4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrRes4
        GrRes4.Cosmetic = True
        GrRes4.Properties("PenColor") = Gr.Properties("PenColor")
'????????????????????????????????????????????????????????????????
Dim GrLine As Graphic
        Set GrLine = Grs.Add(11)
        GrLine.Vertices.UseWorldCS = True
        With GrLine.Vertices
            .Add 0, 0, 0
            .Add H, 0, 0
        End With
'        GrLine.Properties("PenColor") = RGB(255, 0, 0)
'        GrLine.Properties("PenWidth") = 0.03
        GrIndex = GrLine.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrLine
        GrLine.Cosmetic = True
Dim xx0#, yy0#, zz0#, xx1#, yy1#, zz1#
        GrLine.Vertices.UseWorldCS = False
        With GrLine.Vertices
            xx0 = .Item(0).X
            yy0 = .Item(0).Y
            zz0 = .Item(0).Z
            xx1 = .Item(1).X
            yy1 = .Item(1).Y
            zz1 = .Item(1).Z
        End With
         Gr.Vertices.UseWorldCS = False
        With Gr.Vertices
            X00New = .Item(0).X
            Y00New = .Item(0).Y
            Z00New = .Item(0).Z
        End With
'        GrLine.MoveRelative X00New - xx0, Y00New - yy0, Z00New - zz0  '!!!!!!!
        GrRes4.MoveRelative X00New - xx0, Y00New - yy0, Z00New - zz0 '!!!!!!!
        GrLine.Deleted = True
'????????????????????????????????????????????????????????????????
    Else
        GrIndex = Gr5.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr5
        Gr5.Cosmetic = True

        Set GrRes4 = GrRes5
        GrIndex = GrRes4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrRes4
        GrRes4.Cosmetic = True

    End If

    Set Gr1 = Nothing
    Set Gr2 = Nothing
    Set Gr3 = Nothing
    Set Gr4 = Nothing
    Set Gr5 = Nothing
    Set Gr6 = Nothing
    Set Gr7 = Nothing
    Set Gr8 = Nothing
    Set GrRes1 = Nothing
    Set GrRes2 = Nothing
    Set GrRes3 = Nothing
    Set GrRes4 = Nothing
    Set GrRes5 = Nothing
    Set GrRes6 = Nothing
    Set GrRes7 = Nothing
    Set GrTemp = Nothing
    Set Grs = Nothing
    Set Bool3D = Nothing

Exit Sub
Failed:

        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If
End Sub

' LowCrownNut

Private Sub LowCrownNut(Gr As Graphic, dd As Double, Salp As Double, Calp As Double, SSolid As Integer, AddScale As Double)
On Error GoTo Failed
Dim Grs As Graphics
    Set Grs = Gr.Drawing.Graphics
Dim D#, H#, s#, del#
        D = 1.84 * dd
        H = 0.7 * dd
        s = D * Cos(Pi / 6)
        del = 0.1 * dd

        Gr.Vertices.UseWorldCS = True

Dim X00#, Y00#, Z00#, X01#, Y01#, Z01#, L#

       With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            Z00 = .Item(0).Z
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            Z01 = .Item(1).Z
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00) + (Z01 - Z00) * (Z01 - Z00)) '!!!!!!!
            .Item(1).X = X00 + (X01 - X00) * H / AddScale / L
            .Item(1).Y = Y00 + (Y01 - Y00) * H / AddScale / L
            .Item(1).Z = Z00 + (Z01 - Z00) * H / AddScale / L
            X01 = X00 + (X01 - X00) * H / L '!!!!!!!
            Y01 = Y00 + (Y01 - Y00) * H / L '!!!!!!!
            Z01 = Z00 + (Z01 - Z00) * H / L '!!!!!!!
        End With

Dim X00New#, Y00New#, Z00New#, X01New#, Y01New#, Z01New#
        X00New = X00    '!!!!!!!
        Y00New = Y00    '!!!!!!!
        Z00New = Z00    '!!!!!!!
        X01New = X01    '!!!!!!!
        Y01New = Y01    '!!!!!!!
        Z01New = Z01    '!!!!!!!
        X00 = 0#    '!!!!!!!
        Y00 = 0#    '!!!!!!!
        Z00 = 0#    '!!!!!!!
        X01 = H    '!!!!!!!
        Y01 = 0#    '!!!!!!!
        Z01 = 0#    '!!!!!!!

Dim x0(100)
Dim y0(100)
Dim X(100)
Dim Y(100)

Dim i As Long
' Head of the bolt
    For i = 7 To 13
        x0(i) = D / 2 * Cos(Pi / 3 * (i - 7))
        y0(i) = D / 2 * Sin(Pi / 3 * (i - 7))
    Next i
Dim Gr1 As Graphic
Set Gr1 = Grs.Add(gkGraphic)
Gr1.Vertices.UseWorldCS = True
With Gr1.Vertices
    For i = 7 To 13
        .Add x0(i), y0(i), 0, True, True, False, False, False, False
    Next i
End With
Gr1.Closed = True
Gr1.Properties("Thickness") = H
Gr1.Properties("Solid") = SSolid
Dim xTo#, yTo#, zTo#, xFrom#, yFrom#, zFrom#, xRef#, yRef#, zRef#
    xTo = X00 + (X01 - X00) / H
    yTo = Y00 + (Y01 - Y00) / H
    zTo = 0
    xFrom = X00
    yFrom = Y00
    zFrom = -1#
    xRef = X00
    yRef = Y00
    zRef = 0#
    Gr1.RotateAbsolute xTo, yTo, zTo, xFrom, yFrom, zFrom, xRef, yRef, zRef
'################################################################
'################################################################
Dim T#
    T = D / 2 * Sin(Pi / 3)
       x0(1) = -0.1 * H
       y0(1) = T * 0.7 - 0.1 * H / Tan(Pi / 6)

       x0(2) = -0.1 * H
       y0(2) = D

       x0(3) = 0.4 * H
       y0(3) = D

       x0(4) = 0.4 * H
       y0(4) = T * 0.7 + 0.5 * H / Tan(Pi / 6)

       x0(5) = x0(1)
       y0(5) = y0(1)

'-----------------------------------------------------------

Dim GrTemp As Graphic
            Set GrTemp = Grs.Add(gkGraphic)
            GrTemp.Vertices.UseWorldCS = True
            With GrTemp.Vertices
                For i = 1 To 5
                    .Add x0(i), y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
Dim Gr2 As Graphic '1 faska
            Set Gr2 = Grs.Add(, "TCW40SPIN")
            Gr2.Vertices.UseWorldCS = True
            Gr2.Properties("Solid") = SSolid
            Gr2.Properties("$ROTATIONANGLE") = 360#
            Gr2.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr2.Graphics.AddGraphic GrTemp
            Gr2.Vertices.Add X00, Y00, 0, False, False, False, False, False
            Gr2.Vertices.Add X01, Y01, 0, False, False, False, False, False
Dim Gr3 As Graphic ' 2 faska
            Set Gr3 = Gr2.Duplicate
            Gr3.RotateAxis Pi, 0, 0, 1, X00, Y00, Z00
            Gr3.MoveRelative H, 0, 0

' Internal Hole
       x0(1) = -del
       y0(1) = 0#

       x0(2) = -del
       y0(2) = dd / 2 + del

       x0(3) = del
       y0(3) = dd / 2 - del

       x0(4) = 1.3 * H - del
       y0(4) = dd / 2 - del

       x0(5) = 1.3 * H + del
       y0(5) = dd / 2 + del

       x0(6) = 1.3 * H + del
       y0(6) = 0

       x0(7) = x0(1)
       y0(7) = y0(1)

'-----------------------------------------------------------

            Set GrTemp = Grs.Add(gkGraphic)
            GrTemp.Vertices.UseWorldCS = True
            With GrTemp.Vertices
                For i = 1 To 7
                    .Add x0(i), y0(i), 0
                Next i
            End With
            GrTemp.Closed = True
Dim Gr4 As Graphic
            Set Gr4 = Grs.Add(, "TCW40SPIN")
            Gr4.Vertices.UseWorldCS = True
            Gr4.Properties("Solid") = SSolid
            Gr4.Properties("$ROTATIONANGLE") = 360#
            Gr4.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr4.Graphics.AddGraphic GrTemp
            Gr4.Vertices.Add X00, Y00, 0, False, False, False, False, False
            Gr4.Vertices.Add X01, Y01, 0, False, False, False, False, False

' Thread
    'Base contour
Dim hThread# ' Step of the thread
    hThread = del / Sin(Pi / 3)
Dim nCoil As Long ', K As Long
    nCoil = 10
    nCoil = CLng(H / hThread) + 2

'    x0(1) = -hThread
'    y0(1) = dd / 2 - 2# * del

'    x0(2) = -hThread
'    y0(2) = dd / 2 - 1.1 * del

'    x0(3) = -hThread / 2
'    y0(3) = dd / 2

'    x0(4) = 0#
'    y0(4) = dd / 2 - 1.1 * del

'    x0(5) = 0#
'    y0(5) = dd / 2 - 2# * del

'    x0(6) = x0(1)
'    y0(6) = y0(1)

Dim lThread#
    lThread = nCoil * hThread
Dim k As Long

    x0(1) = 0#
    y0(1) = 0#

    x0(2) = 0#
    y0(2) = dd / 2 - del

    k = 2

    For i = 1 To nCoil
        k = k + 1
        x0(k) = x0(k - 1) + hThread / 2
        y0(k) = y0(k - 1) + del
        k = k + 1
        x0(k) = x0(k - 1) + hThread / 2
        y0(k) = y0(k - 1) - del
    Next i
    k = k + 1
    x0(k) = lThread
    y0(k) = 0

    k = k + 1
    x0(k) = 0
    y0(k) = 0

Set GrTemp = Grs.Add(gkGraphic)
GrTemp.Vertices.UseWorldCS = True
With GrTemp.Vertices
    For i = 1 To k '6
        .Add x0(i), y0(i), 0
    Next i
End With
GrTemp.Closed = True

Dim Gr5 As Graphic
Set Gr5 = Grs.Add(, "TCW40SPIN")
Gr5.Vertices.UseWorldCS = True
Gr5.Properties("Solid") = SSolid
Gr5.Properties("$ROTATIONANGLE") = 360#
'Gr5.Properties("$SPIRENUMBER") = nCoil
'Gr5.Properties("$STEP") = 1.05 * hThread  '1.015
Gr5.Properties("$ROTATIONCOPY") = 30
Set GrTemp = Grs.Remove(GrTemp.Index)
Gr5.Graphics.AddGraphic GrTemp
Gr5.Vertices.Add X00, Y00, 0, False, False, False, False, False
Gr5.Vertices.Add X01, Y01, 0, False, False, False, False, False

'Crown
Dim fi#, dfi#
        dfi = Pi / 2 / 20
       x0(1) = 0.8 * H
       y0(1) = 0#

       x0(2) = 0.8 * H
       y0(2) = 0.9 * s / 2#

       x0(3) = H
       y0(3) = 0.9 * s / 2#
Dim m%
        m = 3
       For i = 1 To 20
            m = m + 1
            fi = Pi / 2 - i * dfi
            x0(m) = H + 0.9 * s / 2 * Cos(fi)
            y0(m) = 0.9 * s / 2 * Sin(fi)
       Next i
       m = m + 1
       x0(m) = x0(1)
       y0(m) = y0(1)

'-----------------------------------------------------------

            Set GrTemp = Grs.Add(gkGraphic)
            GrTemp.Vertices.UseWorldCS = True
            With GrTemp.Vertices
                For i = 1 To m
                    .Add x0(i), y0(i), 0
                Next i
            End With
            GrTemp.Closed = True

Dim Gr6 As Graphic
            Set Gr6 = Grs.Add(, "TCW40SPIN")
            Gr6.Vertices.UseWorldCS = True
            Gr6.Properties("Solid") = SSolid
            Gr6.Properties("$ROTATIONANGLE") = 360#
            Gr6.Properties("$ROTATIONCOPY") = 30
            Set GrTemp = Grs.Remove(GrTemp.Index)
            Gr6.Graphics.AddGraphic GrTemp
            Gr6.Vertices.Add X00, Y00, 0, False, False, False, False, False
            Gr6.Vertices.Add X01, Y01, 0, False, False, False, False, False

'#################################################################
'################################################################
Dim Bool3D As Boolean3D
Dim GrRes1 As Graphic
Dim Res As Long
Dim GrIndex As Long
    Set Bool3D = New Boolean3D
    Res = 1
    Gr1.Update
    Gr2.Update
    Set GrRes1 = Bool3D.Subtract(Gr1, Gr2, Res)
    If Res = 0 Then
        Gr1.Deleted = True
        Gr2.Deleted = True
        Grs.AddGraphic GrRes1
    Else
        GrIndex = Gr2.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr2
        Gr2.Cosmetic = True
        Set GrRes1 = Gr1
    End If
Dim GrRes2 As Graphic
    GrRes1.Update
    Gr3.Update
    Set GrRes2 = Bool3D.Subtract(GrRes1, Gr3, Res)
    If Res = 0 Then
        GrRes1.Deleted = True
        Gr3.Deleted = True
        Grs.AddGraphic GrRes2
    Else
        GrIndex = Gr3.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr3
        Gr3.Cosmetic = True
        Set GrRes2 = GrRes1
    End If

Dim GrRes5 As Graphic
    GrRes2.Update
    Gr6.Update
    Set GrRes5 = Bool3D.Add(GrRes2, Gr6, Res)
    If Res = 0 Then
        GrRes2.Deleted = True
        Gr6.Deleted = True
        Grs.AddGraphic GrRes5
    Else
        GrIndex = Gr6.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr6
        Gr6.Cosmetic = True
        Set GrRes5 = GrRes2
    End If

Dim GrRes3 As Graphic
    GrRes5.Update
    Gr4.Update
    Set GrRes3 = Bool3D.Subtract(GrRes5, Gr4, Res)
    If Res = 0 Then
        GrRes5.Deleted = True
        Gr4.Deleted = True
        Grs.AddGraphic GrRes3
    Else
        GrIndex = Gr4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr4
        Gr4.Cosmetic = True
        Set GrRes3 = GrRes5
    End If

Dim GrRes4 As Graphic
    GrRes3.Update
    Gr5.Update
    Set GrRes4 = Bool3D.Subtract(GrRes3, Gr5, Res)
    If Res = 0 Then
        GrRes3.Deleted = True
        Gr5.Deleted = True
        Grs.AddGraphic GrRes4

'Dim Matr As Matrix
'        Set Matr = GrRes4.Scale(1# / AddScale, 1# / AddScale, 1# / AddScale, X00, Y00, Z00)
'        GrRes4.MoveRelative 3, 5, 0

        GrIndex = GrRes4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrRes4
        GrRes4.Cosmetic = True
        GrRes4.Properties("PenColor") = Gr.Properties("PenColor")
 '????????????????????????????????????????????????????????????????
Dim GrLine As Graphic
        Set GrLine = Grs.Add(11)
        GrLine.Vertices.UseWorldCS = True
        With GrLine.Vertices
            .Add 0, 0, 0
            .Add H, 0, 0
        End With
'        GrLine.Properties("PenColor") = RGB(255, 0, 0)
'        GrLine.Properties("PenWidth") = 0.03
        GrIndex = GrLine.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrLine
        GrLine.Cosmetic = True
Dim xx0#, yy0#, zz0#, xx1#, yy1#, zz1#
        GrLine.Vertices.UseWorldCS = False
        With GrLine.Vertices
            xx0 = .Item(0).X
            yy0 = .Item(0).Y
            zz0 = .Item(0).Z
            xx1 = .Item(1).X
            yy1 = .Item(1).Y
            zz1 = .Item(1).Z
        End With
         Gr.Vertices.UseWorldCS = False
        With Gr.Vertices
            X00New = .Item(0).X
            Y00New = .Item(0).Y
            Z00New = .Item(0).Z
        End With
'        GrLine.MoveRelative X00New - xx0, Y00New - yy0, Z00New - zz0  '!!!!!!!
        GrRes4.MoveRelative X00New - xx0, Y00New - yy0, Z00New - zz0 '!!!!!!!
        GrLine.Deleted = True
'????????????????????????????????????????????????????????????????

    Else
        GrIndex = Gr5.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic Gr5
        Gr5.Cosmetic = True

        Set GrRes4 = GrRes3
        GrIndex = GrRes4.Index
        Grs.Remove GrIndex
        Gr.Graphics.AddGraphic GrRes4
        GrRes4.Cosmetic = True

    End If

    Set Gr1 = Nothing
    Set Gr2 = Nothing
    Set Gr3 = Nothing
    Set Gr4 = Nothing
    Set Gr5 = Nothing
    Set Gr6 = Nothing
    Set GrRes1 = Nothing
    Set GrRes2 = Nothing
    Set GrRes3 = Nothing
    Set GrRes4 = Nothing
    Set GrRes5 = Nothing
    Set GrTemp = Nothing
    Set Grs = Nothing
    Set Bool3D = Nothing

Exit Sub
Failed:

        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If
End Sub

'defines the distance frof line to point in 3D space
Private Function DistPointLine(x0 As Double, y0 As Double, z0 As Double, x1 As Double, y1 As Double, z1 As Double, x2 As Double, y2 As Double, z2 As Double) As Double

Dim l1#, m1#, n1#
        l1 = x2 - x1
        m1 = y2 - y1
        n1 = z2 - z1
Dim t1#, t2#, t3#
        t1 = (y0 - y1) * n1 - (z0 - z1) * m1
        t2 = (z0 - z1) * l1 - (x0 - x1) * n1
        t3 = (x0 - x1) * m1 - (y0 - y1) * l1
Dim s0#, s1#, s2#
        s1 = Sqr(t1 * t1 + t2 * t2 + t3 * t3)
        s2 = Sqr(l1 * l1 + m1 * m1 + n1 * n1)
        DistPointLine = s1 / s2
End Function


Examples - 3D Nut Regen - Nut3.frm

Nut3.frm

3D Nut Regen Example

VERSION 5.00
Begin VB.Form frmNut3
   BorderStyle     =   1  'Fixed Single
   Caption         =   "3D Nuts"
   ClientHeight    =   4485
   ClientLeft      =   6420
   ClientTop       =   2910
   ClientWidth     =   5730
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4485
   ScaleWidth      =   5730
   StartUpPosition =   1  'CenterOwner
   Begin VB.OptionButton Surf_Solid1
      Caption         =   "Solid"
      Height          =   255
      Left            =   3000
      TabIndex        =   8
      Top             =   3480
      Value           =   -1  'True
      Width           =   855
   End
   Begin VB.OptionButton Surf_Solid
      Caption         =   "Surface"
      Height          =   255
      Left            =   3000
      TabIndex        =   7
      Top             =   3120
      Width           =   975
   End
   Begin VB.ListBox List1
      Height          =   2400
      ItemData        =   "Nut3.frx":0000
      Left            =   120
      List            =   "Nut3.frx":000D
      TabIndex        =   3
      Top             =   360
      Width           =   2535
   End
   Begin VB.TextBox txtdd
      Height          =   285
      Left            =   2040
      TabIndex        =   2
      Top             =   3000
      Width           =   615
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   4320
      TabIndex        =   0
      Top             =   3960
      Width           =   1212
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   2880
      TabIndex        =   1
      Top             =   3960
      Width           =   1215
   End
   Begin VB.Frame Frame1
      Caption         =   "3D"
      Height          =   975
      Left            =   2880
      TabIndex        =   6
      Top             =   2880
      Width           =   1335
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "Diameter (d) :"
      Height          =   255
      Left            =   720
      TabIndex        =   5
      Top             =   3000
      Width           =   1215
   End
   Begin VB.Image PicPreview
      BorderStyle     =   1  'Fixed Single
      Height          =   2640
      Left            =   2880
      Stretch         =   -1  'True
      Top             =   120
      Width           =   2595
   End
   Begin VB.Label Label3
      Caption         =   "NutType :"
      Height          =   255
      Left            =   120
      TabIndex        =   4
      Top             =   120
      Width           =   735
   End
End
Attribute VB_Name = "frmNut3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    TypeN = List1.Text
    Me.Hide
End Sub

Private Sub Form_Load()
Dim i%, iDef%
    For i = 0 To List1.ListCount - 1
        If List1.List(i) = TypeN Then iDef = i
    Next i
    List1.ListIndex = iDef

'    HexNut.Visible = False
'    HexSlottedNut.Visible = False
'    LowCrownNut.Visible = False

'    If List1.Text = "HexNut" Then HexNut.Visible = True
'    If List1.Text = "HexSlottedNut" Then HexSlottedNut.Visible = True
'    If List1.Text = "LowCrownNut" Then LowCrownNut.Visible = True
    If List1.Text = "HexNut" Then PicPreview.Picture = LoadResPicture(101, 0)
    If List1.Text = "HexSlottedNut" Then PicPreview.Picture = LoadResPicture(102, 0)
    If List1.Text = "LowCrownNut" Then PicPreview.Picture = LoadResPicture(103, 0)

End Sub

Private Sub List1_Click()
'    HexNut.Visible = False
'    HexSlottedNut.Visible = False
'    LowCrownNut.Visible = False

'    If List1.Text = "HexNut" Then HexNut.Visible = True
'    If List1.Text = "HexSlottedNut" Then HexSlottedNut.Visible = True
'    If List1.Text = "LowCrownNut" Then LowCrownNut.Visible = True
    If List1.Text = "HexNut" Then PicPreview.Picture = LoadResPicture(101, 0)
    If List1.Text = "HexSlottedNut" Then PicPreview.Picture = LoadResPicture(102, 0)
    If List1.Text = "LowCrownNut" Then PicPreview.Picture = LoadResPicture(103, 0)

End Sub


Examples - %%PROJECT_NAME%%Nut2.bas

Nut2.bas

Attribute VB_Name = "Module1"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
Global Const Pi = 3.14159
Global TypeN As String
Global ViewN As String
' DLL Entry point
Sub Main()

End Sub


Examples - %%PROJECT_NAME%%Nut2.cls

Nut2.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Detail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2000                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idNutType = 1
Const idDiameter = 2
Const idLength = 3
Const idView = 4
Const idLengthThread = 5

'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 5
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0
Private PColor As Long
Private BColor As Long

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "Nut"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{FDB6F1C3-9631-11d1-A40A-0000B465872B}"

End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
    Names(0) = "NutType"
    Types(0) = typeString
    IDs(0) = idNutType
    Defaults(0) = "HexNut"

    Names(1) = "DiameterN"
    Types(1) = typeDouble
    IDs(1) = idDiameter
    Defaults(1) = 1#

    Names(2) = "LengthN"
    Types(2) = typeDouble
    IDs(2) = idLength
    Defaults(2) = 3#

    Names(3) = "NutView"
    Types(3) = typeString
    IDs(3) = idView
    Defaults(3) = "Front"

    Names(4) = "LengthThreadN"
    Types(4) = typeDouble
    IDs(4) = idLengthThread
    Defaults(4) = 0#

   GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmSample
    Names(0) = frmSample.Caption
    Unload frmSample

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long

End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed
        Dim i%
        Dim Diameter#, Length#, LThread#
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmSample
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next
                'When the property page is closed, transfer the numeric
                'Diameter value from the TextBox to the Graphic
                'Get the value as a double-precision number
                TypeN = .List1.Text
                ViewN = .List2.Text
                Diameter# = CDbl(.txtdd.Text)
'                Length# = CDbl(.txtLen.Text)
                LThread# = CDbl(.txtLenThread.Text)

                'Make sure it's between 0 and 100
                If Diameter# < 0# Then Diameter# = 1#
                If Diameter# > 3# Then Diameter# = 3#

                'Set the roundness property value in the Graphic
                Graphic.Properties("DiameterN") = Diameter#
'                Graphic.Properties("Length") = Length#
                Graphic.Properties("NutType") = TypeN
                Graphic.Properties("NutView") = ViewN
                Graphic.Properties("LengthThreadN") = LThread

            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmSample
            With frmSample

                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                'roundness value from the Graphic to the TextBox
                'Get the roundness property value from the Graphic
                Diameter# = Graphic.Properties("DiameterN")
'                Length# = Graphic.Properties("Length")
                TypeN = Graphic.Properties("NutType")
                ViewN = Graphic.Properties("NutView")
                LThread = Graphic.Properties("LengthThreadN")
            'Set the TextBox control's text
                .txtdd.Text = Diameter#
'                .txtLen = Length#
                .List1.Text = TypeN
                .List2.Text = ViewN
                .txtLenThread.Text = LThread
NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmSample
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmSample
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If

    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "first point of axis"
    grfThis.Vertices.Add 0#, 0, 0#, False, True, True, True, True, False

    'Second Vertex is "Second point of axis"

    grfThis.Vertices.Add 3#, 0, 0#, False, True, True, True, True, False
    grfThis.Properties("PenColor") = RGB(0, 0, 0)
    grfThis.Properties("BrushColor") = RGB(255, 255, 255)

    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis As Object)
        'Setup error handler
        On Error GoTo Failed

        'Set up lock (prevent recursion)
        Dim LockCount&
        LockCount& = grfThis.RegenLock
        PColor = grfThis.Properties("PenColor")
'        BColor = grfThis.Properties("BrushColor")
''AALB problem with load old files
' AALB try to fix bug with reading files from TC v6.5 (problem is that some sdk regens
' has Type = 7(Group, must be GRAPHIc (11))
On Error Resume Next
Err.Clear
        BColor = grfThis.Properties("BrushColor")
        If Err.Number <> 0 Then
            BColor = RGB(255, 255, 255)
            Err.Clear
        End If

        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
            grfThis.Graphics.Clear gfCosmetic

            TypeN = grfThis.Properties("NutType")
            ViewN = grfThis.Properties("NutView")

            Dim dd#
                dd = grfThis.Properties("DiameterN")

            Dim LThread#
                LThread = grfThis.Properties("LengthThreadN")
Dim X00#, Y00#, X01#, Y01#
            With grfThis.Vertices
                X00 = .Item(0).X
                Y00 = .Item(0).Y
                X01 = .Item(1).X
                Y01 = .Item(1).Y
                If Abs(X00 - X01) < 0.001 And Abs(Y00 - Y01) < 0.001 Then
                    .Item(1).X = X00 + 1#
                    .Item(1).Y = Y00
                End If
            End With
'##########################################################
            If TypeN = "HexNut" Then
                Call HexNut(grfThis, dd, LThread)
            End If

            If TypeN = "HexFlangeNut" Then
                Call HexFlangeNut(grfThis, dd, LThread)
            End If

            If TypeN = "HexSlottedNut" Then
                Call HexSlottedNut(grfThis, dd, LThread)
            End If

            If TypeN = "LowCrownNut" Then
                Call LowCrownNut(grfThis, dd, LThread)
            End If

            If TypeN = "SquareNut" Then
                Call SquareNut(grfThis, dd, LThread)
            End If

            'Add visible child Graphics
        End If

        grfThis.RegenUnlock
        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:

'        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
'        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function
Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function

Private Sub HexNut(Gr As Graphic, dd As Double, LThread As Double)
Dim D#, H#, S#, K#, del#
        D = 1.84 * dd
        H = 1# * dd
        S = D * Cos(Pi / 6)
        K = D / 2 * (1 - Cos(Pi / 6)) * Tan(Pi / 6)
        del = 0.15 * dd
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim Salp#, Calp#, L#
Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
            Salp = (Y01 - Y00) / L
            Calp = (X01 - X00) / L
        End With
        If Abs(H - L) > 0.0001 Then
            X01 = X00 + H * Calp
            Y01 = Y00 + H * Salp
            With Gr.Vertices
                .Item(1).X = X01
                .Item(1).Y = Y01
                L = H
            End With
        End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Dim x0(26)
Dim y0(26)
Dim X(26)
Dim Y(26)

       x0(1) = 0#
       y0(1) = S / 2#

       x0(2) = x0(1)
       y0(2) = -y0(1)

       x0(3) = K
       y0(3) = D / 2#

       x0(4) = x0(3)
       y0(4) = -y0(3)

       x0(5) = H - K
       y0(5) = D / 2

       x0(6) = x0(5)
       y0(6) = -y0(5)

       x0(7) = H
       y0(7) = S / 2#

       x0(8) = x0(7)
       y0(8) = -y0(7)

       x0(9) = x0(3)
       y0(9) = D / 4

       x0(10) = x0(9)
       y0(10) = -y0(9)

       x0(11) = x0(5)
       y0(11) = D / 4#

       x0(12) = x0(11)
       y0(12) = -y0(11)

       x0(13) = 0#
       y0(13) = 3 * D / 8

       x0(14) = x0(13)
       y0(14) = -y0(13)

       x0(15) = H
       y0(15) = 3 * D / 8

       x0(16) = x0(15)
       y0(16) = -y0(15)

       x0(17) = 0
       y0(17) = 0

       x0(18) = H
       y0(18) = 0#

' Thread
       x0(19) = H
       y0(19) = dd / 2

       x0(20) = x0(19)
       y0(20) = -y0(19)

       x0(21) = H + LThread - del
       y0(21) = dd / 2

       x0(22) = x0(21)
       y0(22) = -y0(21)

       x0(23) = H + LThread
       y0(23) = dd / 2 - del

       x0(24) = x0(23)
       y0(24) = -y0(23)

       x0(25) = H
       y0(25) = dd / 2 - del

       x0(26) = x0(25)
       y0(26) = -y0(25)

Dim i%
       For i = 1 To 26
          X(i) = X00 + x0(i) * Calp - y0(i) * Salp
          Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
        If ViewN = "Front" Then
            If LThread > 0.01 * dd Then
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(19), Y(19), 0, True, True, False, False, False, False
                    .Add X(21), Y(21), 0, True, True, False, False, False, False
                    .Add X(23), Y(23), 0, True, True, False, False, False, False
                    .Add X(24), Y(24), 0, True, True, False, False, False, False
                    .Add X(22), Y(22), 0, True, True, False, False, False, False
                    .Add X(20), Y(20), 0, True, True, False, False, False, False
                    .Add X(19), Y(19), 0, True, True, False, False, False, False
                End With
                GrChild.Closed = True
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                GrChild.Properties("BrushStyle") = "Solid"
'                GrChild.Properties("BrushColor") = RGB(255, 255, 255)
                GrChild.Properties("BrushColor") = BColor
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(19), Y(19), 0, True, True, False, False, False, False
                    .Add X(20), Y(20), 0, True, True, False, False, False, False
                    .Add X(21), Y(21), 0, False, True, False, False, False, False
                    .Add X(22), Y(22), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(25), Y(25), 0, True, True, False, False, False, False
                    .Add X(23), Y(23), 0, True, True, False, False, False, False
                    .Add X(26), Y(26), 0, False, True, False, False, False, False
                    .Add X(24), Y(24), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenColor") = PColor
            End If
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                    GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
            End With
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
             Set GrChild = Gr.Graphics.Add(gkGraphic)
                       GrChild.Cosmetic = True
             With GrChild.Vertices
                 .Add X(9), Y(9), 0, True, True, False, False, False, False
                 .Add X(11), Y(11), 0, True, True, False, False, False, False
                 .Add X(10), Y(10), 0, False, True, False, False, False, False
                 .Add X(12), Y(12), 0, True, True, False, False, False, False
             End With
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '14
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(3), Y(3), 0#, X(13), Y(13), 0#, X(9), Y(9), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '15
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(9), Y(9), 0#, X(17), Y(17), 0#, X(10), Y(10), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '16
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, X(14), Y(14), 0#, X(4), Y(4), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

            '14
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(5), Y(5), 0#, X(15), Y(15), 0#, X(11), Y(11), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
             GrChild.Properties("PenColor") = PColor
           '15
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(11), Y(11), 0#, X(18), Y(18), 0#, X(12), Y(12), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '16
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(12), Y(12), 0#, X(16), Y(16), 0#, X(6), Y(6), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
        End If
'-------------------------------------------------------------
        If ViewN = "Top" Then
' View Top
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                For i = 0 To 6
                    x0(i) = D / 2 * Cos(Pi / 3 * i)
                    y0(i) = D / 2 * Sin(Pi / 3 * i)
                    X(i) = X00 + x0(i) * Calp - y0(i) * Salp
                    Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
                   .Add X(i), Y(i), 0, True, True, False, False, False, False
                Next i
            End With
             GrChild.Closed = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             GrChild.Properties("BrushStyle") = "Solid"
'             GrChild.Properties("BrushColor") = RGB(255, 255, 255)
             GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + D / 2 * Sin(Pi / 3), Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
             GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2 - del, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            x0(7) = D / 2
            y0(7) = 0
            X(7) = X00 + x0(7) * Calp - y0(7) * Salp
            Y(7) = Y00 + x0(7) * Salp + y0(7) * Calp

           With Gr.Vertices
                .Item(1).X = X(7)
                .Item(1).Y = Y(7)
            End With
        End If
End Sub

Private Sub LowCrownNut(Gr As Graphic, dd As Double, LThread As Double)
Dim D#, H#, S#, K#
        D = 1.63 * dd
        H = 0.72 * dd
        S = D * Cos(Pi / 6)
        K = D / 2 * (1 - Cos(Pi / 6)) * Tan(Pi / 6)
Dim Q#
        Q = 1.55 * dd '1.55
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim Salp#, Calp#, L#
Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
            Salp = (Y01 - Y00) / L
            Calp = (X01 - X00) / L
        End With
        If Abs(H - L) > 0.0001 Then
            X01 = X00 + H * Calp
            Y01 = Y00 + H * Salp
            With Gr.Vertices
                .Item(1).X = X01
                .Item(1).Y = Y01
                L = H
            End With
        End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Dim x0(19)
Dim y0(19)
Dim X(19)
Dim Y(19)

       x0(1) = 0#
       y0(1) = S / 2#

       x0(2) = x0(1)
       y0(2) = -y0(1)

       x0(3) = K
       y0(3) = D / 2#

       x0(4) = x0(3)
       y0(4) = -y0(3)

       x0(5) = H - K
       y0(5) = D / 2

       x0(6) = x0(5)
       y0(6) = -y0(5)

       x0(7) = H
       y0(7) = S / 2#

       x0(8) = x0(7)
       y0(8) = -y0(7)

       x0(9) = x0(3)
       y0(9) = D / 4

       x0(10) = x0(9)
       y0(10) = -y0(9)

       x0(11) = x0(5)
       y0(11) = D / 4#

       x0(12) = x0(11)
       y0(12) = -y0(11)

       x0(13) = 0#
       y0(13) = 3 * D / 8

       x0(14) = x0(13)
       y0(14) = -y0(13)

       x0(15) = H
       y0(15) = 3 * D / 8

       x0(16) = x0(15)
       y0(16) = -y0(15)

       x0(17) = 0
       y0(17) = 0

       x0(18) = H
       y0(18) = 0#

       x0(19) = Q
       y0(19) = 0#

Dim i%
       For i = 1 To 19
          X(i) = X00 + x0(i) * Calp - y0(i) * Salp
          Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
        If ViewN = "Front" Then
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
            End With
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(9), Y(9), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, False, True, False, False, False, False
                .Add X(12), Y(12), 0, True, False, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(3), Y(3), 0#, X(13), Y(13), 0#, X(9), Y(9), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(9), Y(9), 0#, X(17), Y(17), 0#, X(10), Y(10), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '16
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, X(14), Y(14), 0#, X(4), Y(4), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(5), Y(5), 0#, X(15), Y(15), 0#, X(11), Y(11), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(11), Y(11), 0#, X(18), Y(18), 0#, X(12), Y(12), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '16
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(12), Y(12), 0#, X(16), Y(16), 0#, X(6), Y(6), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
    'Elliptical Arc
           Set GrChild = Gr.Graphics.AddArcRotatedElliptical((X(7) + X(8)) / 2, (Y(7) + Y(8)) / 2, 0#, X(19), Y(19), 0#, X(7), Y(7), 0#, -Pi / 2, Pi / 2)
                      GrChild.Cosmetic = True
Dim GrHatch As Graphic
           Set GrHatch = GrChild.Graphics.AddHatch
                      GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrChild.Deleted = True
           Set GrChild = Gr.Graphics.AddArcRotatedElliptical((X(7) + X(8)) / 2, (Y(7) + Y(8)) / 2, 0#, X(19), Y(19), 0#, X(7), Y(7), 0#, -Pi / 2, Pi / 2)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

        End If

'-------------------------------------------------------------
' View Top
        If ViewN = "Top" Then
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                For i = 0 To 6
                    x0(i) = D / 2 * Cos(Pi / 3 * i)
                    y0(i) = D / 2 * Sin(Pi / 3 * i)
                    X(i) = X00 + x0(i) * Calp - y0(i) * Salp
                    Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
                   .Add X(i), Y(i), 0, True, True, False, False, False, False
                Next i
            End With
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             GrChild.Properties("BrushStyle") = "Solid"
'             GrChild.Properties("BrushColor") = RGB(255, 255, 255)
             GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + D / 2 * Sin(Pi / 3), Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            x0(7) = D / 2
            y0(7) = 0
            X(7) = X00 + x0(7) * Calp - y0(7) * Salp
            Y(7) = Y00 + x0(7) * Salp + y0(7) * Calp

           With Gr.Vertices
                .Item(1).X = X(7)
                .Item(1).Y = Y(7)
            End With
        End If
End Sub

Private Sub SquareNut(Gr As Graphic, dd As Double, LThread As Double)
Dim D#, H#, S#, K#, del#
        D = 2# * dd
        H = 0.9 * dd
        S = D * Cos(Pi / 4)
        K = 0.5 * (D - S) * Tan(Pi / 6)
        del = 0.15 * dd
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim Salp#, Calp#, L#
Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
            Salp = (Y01 - Y00) / L
            Calp = (X01 - X00) / L
        End With
        If Abs(H - L) > 0.0001 Then
            X01 = X00 + H * Calp
            Y01 = Y00 + H * Salp
            With Gr.Vertices
                .Item(1).X = X01
                .Item(1).Y = Y01
                L = H
            End With
        End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Dim x0(22)
Dim y0(22)
Dim X(22)
Dim Y(22)

       x0(1) = 0#
       y0(1) = S / 2#

       x0(2) = x0(1)
       y0(2) = -y0(1)

       x0(3) = K
       y0(3) = D / 2#

       x0(4) = x0(3)
       y0(4) = -y0(3)

       x0(5) = H - K
       y0(5) = D / 2

       x0(6) = x0(5)
       y0(6) = -y0(5)

       x0(7) = H
       y0(7) = S / 2#

       x0(8) = x0(7)
       y0(8) = -y0(7)

       x0(9) = x0(3)
       y0(9) = 0#

       x0(10) = x0(5)
       y0(10) = 0#

       x0(11) = 0
       y0(11) = D / 4#

       x0(12) = x0(11)
       y0(12) = -y0(11)

       x0(13) = H
       y0(13) = D / 4

       x0(14) = x0(13)
       y0(14) = -y0(13)

' Thread
       x0(15) = H
       y0(15) = dd / 2

       x0(16) = x0(15)
       y0(16) = -y0(15)

       x0(17) = H + LThread - del
       y0(17) = dd / 2

       x0(18) = x0(17)
       y0(18) = -y0(17)

       x0(19) = H + LThread
       y0(19) = dd / 2 - del

       x0(20) = x0(19)
       y0(20) = -y0(19)

       x0(21) = H
       y0(21) = dd / 2 - del

       x0(22) = x0(21)
       y0(22) = -y0(21)

Dim i%
       For i = 1 To 22
          X(i) = X00 + x0(i) * Calp - y0(i) * Salp
          Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
        If ViewN = "Front" Then
            If LThread > 0.01 * dd Then
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(15), Y(15), 0, True, True, False, False, False, False
                    .Add X(17), Y(17), 0, True, True, False, False, False, False
                    .Add X(19), Y(19), 0, True, True, False, False, False, False
                    .Add X(20), Y(20), 0, True, True, False, False, False, False
                    .Add X(18), Y(18), 0, True, True, False, False, False, False
                    .Add X(16), Y(16), 0, True, True, False, False, False, False
                    .Add X(15), Y(15), 0, True, True, False, False, False, False
                End With
                GrChild.Closed = True
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                GrChild.Properties("BrushStyle") = "Solid"
'                GrChild.Properties("BrushColor") = RGB(255, 255, 255)
                GrChild.Properties("BrushColor") = BColor
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(17), Y(17), 0, False, True, False, False, False, False
                    .Add X(18), Y(18), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(21), Y(21), 0, True, True, False, False, False, False
                    .Add X(19), Y(19), 0, True, True, False, False, False, False
                    .Add X(22), Y(22), 0, False, True, False, False, False, False
                    .Add X(20), Y(20), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenColor") = PColor
            End If
             Set GrChild = Gr.Graphics.Add(gkGraphic)
                       GrChild.Cosmetic = True
             With GrChild.Vertices
                 .Add X(1), Y(1), 0, True, True, False, False, False, False
                 .Add X(3), Y(3), 0, True, True, False, False, False, False
                 .Add X(5), Y(5), 0, True, True, False, False, False, False
                 .Add X(7), Y(7), 0, True, True, False, False, False, False
                 .Add X(8), Y(8), 0, True, True, False, False, False, False
                 .Add X(6), Y(6), 0, True, True, False, False, False, False
                 .Add X(4), Y(4), 0, True, True, False, False, False, False
                 .Add X(2), Y(2), 0, True, True, False, False, False, False
                 .Add X(1), Y(1), 0, True, True, False, False, False, False
             End With
             GrChild.Closed = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'             GrChild.Properties("BrushColor") = RGB(255, 255, 255)
             GrChild.Properties("BrushColor") = BColor
             Set GrChild = Gr.Graphics.Add(gkGraphic)
                       GrChild.Cosmetic = True
             With GrChild.Vertices
                 .Add X(9), Y(9), 0, True, True, False, False, False, False
                 .Add X(10), Y(10), 0, True, True, False, False, False, False
             End With
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '14
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(3), Y(3), 0#, X(11), Y(11), 0#, X(9), Y(9), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '15
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(9), Y(9), 0#, X(12), Y(12), 0#, X(4), Y(4), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '16
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(5), Y(5), 0#, X(13), Y(13), 0#, X(10), Y(10), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

            '14
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, X(14), Y(14), 0#, X(6), Y(6), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '15
        End If
 '-------------------------------------------------------------
        If ViewN = "Top" Then
' View Top
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                For i = 0 To 4
                    x0(i) = D / 2 * Cos(Pi / 2 * i)
                    y0(i) = D / 2 * Sin(Pi / 2 * i)
                    X(i) = X00 + x0(i) * Calp - y0(i) * Salp
                    Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
                   .Add X(i), Y(i), 0, True, True, False, False, False, False
                Next i
            End With
             GrChild.Closed = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             GrChild.Properties("BrushStyle") = "Solid"
'             GrChild.Properties("BrushColor") = RGB(255, 255, 255)
             GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + D / 2 * Sin(Pi / 4), Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2 - del, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            x0(5) = D / 2
            y0(5) = 0
            X(5) = X00 + x0(5) * Calp - y0(5) * Salp
            Y(5) = Y00 + x0(5) * Salp + y0(5) * Calp

           With Gr.Vertices
                .Item(1).X = X(5)
                .Item(1).Y = Y(5)
            End With
        End If
End Sub

Private Sub HexFlangeNut(Gr As Graphic, dd As Double, LThread As Double)
Dim D#, Dw#, C#, K#, K1#, E#, Di#, del#
        D = 1.7 * dd
        Dw = 1.96 * dd
        C = 0.15 * dd
        K = 1# * dd
        K1 = 0.43 * dd
        E = (K - K1) * 0.85
        Di = D * Sin(Pi / 3#)
        del = 0.15 * dd
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim Salp#, Calp#, L#
Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
            Salp = (Y01 - Y00) / L
            Calp = (X01 - X00) / L
        End With
        If Abs(K - L) > 0.0001 Then
            X01 = X00 + K * Calp
            Y01 = Y00 + K * Salp
            With Gr.Vertices
                .Item(1).X = X01
                .Item(1).Y = Y01
                L = K
            End With
        End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Dim x0(25)
Dim y0(25)
Dim X(25)
Dim Y(25)

       x0(1) = 0#
       y0(1) = Dw / 2#

       x0(2) = x0(1)
       y0(2) = -y0(1)

       x0(3) = C
       y0(3) = Dw / 2#

       x0(4) = x0(3)
       y0(4) = -y0(3)

       x0(5) = K1
       y0(5) = D / 2

       x0(6) = x0(5)
       y0(6) = -y0(5)

       x0(7) = K1 + E
       y0(7) = D / 2#

       x0(8) = x0(7)
       y0(8) = -y0(7)

       x0(9) = K
       y0(9) = Di / 2

       x0(10) = x0(9)
       y0(10) = -y0(9)

       x0(11) = K1
       y0(11) = D / 4#

       x0(12) = x0(11)
       y0(12) = -y0(11)

       x0(13) = x0(7)
       y0(13) = y0(11)

       x0(14) = x0(13)
       y0(14) = -y0(13)

       x0(15) = K
       y0(15) = 3# * D / 8#

       x0(16) = x0(15)
       y0(16) = -y0(15)

       x0(17) = K
       y0(17) = 0#

' Thread
       x0(18) = K
       y0(18) = dd / 2

       x0(19) = x0(18)
       y0(19) = -y0(18)

       x0(20) = K + LThread - del
       y0(20) = dd / 2

       x0(21) = x0(20)
       y0(21) = -y0(20)

       x0(22) = K + LThread
       y0(22) = dd / 2 - del

       x0(23) = x0(22)
       y0(23) = -y0(22)

       x0(24) = K
       y0(24) = dd / 2 - del

       x0(25) = x0(24)
       y0(25) = -y0(24)

Dim i%
       For i = 1 To 25
          X(i) = X00 + x0(i) * Calp - y0(i) * Salp
          Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
        If ViewN = "Front" Then
            If LThread > 0.01 * dd Then
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(18), Y(18), 0, True, True, False, False, False, False
                    .Add X(20), Y(20), 0, True, True, False, False, False, False
                    .Add X(22), Y(22), 0, True, True, False, False, False, False
                    .Add X(23), Y(23), 0, True, True, False, False, False, False
                    .Add X(21), Y(21), 0, True, True, False, False, False, False
                    .Add X(19), Y(19), 0, True, True, False, False, False, False
                    .Add X(18), Y(18), 0, True, True, False, False, False, False
                End With
                GrChild.Closed = True
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                GrChild.Properties("BrushStyle") = "Solid"
'                GrChild.Properties("BrushColor") = RGB(255, 255, 255)
                GrChild.Properties("BrushColor") = BColor
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(20), Y(20), 0, False, True, False, False, False, False
                    .Add X(21), Y(21), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(24), Y(24), 0, True, True, False, False, False, False
                    .Add X(22), Y(22), 0, True, True, False, False, False, False
                    .Add X(25), Y(25), 0, False, True, False, False, False, False
                    .Add X(23), Y(23), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenColor") = PColor
            End If
             Set GrChild = Gr.Graphics.Add(gkGraphic)
                       GrChild.Cosmetic = True
             With GrChild.Vertices
                 .Add X(1), Y(1), 0, True, True, False, False, False, False
                 .Add X(3), Y(3), 0, True, True, False, False, False, False
                 .Add X(5), Y(5), 0, True, True, False, False, False, False
                 .Add X(7), Y(7), 0, True, True, False, False, False, False
                 .Add X(9), Y(9), 0, True, True, False, False, False, False
                 .Add X(10), Y(10), 0, True, True, False, False, False, False
                 .Add X(8), Y(8), 0, True, True, False, False, False, False
                 .Add X(6), Y(6), 0, True, True, False, False, False, False
                 .Add X(4), Y(4), 0, True, True, False, False, False, False
                 .Add X(2), Y(2), 0, True, True, False, False, False, False
                 .Add X(1), Y(1), 0, True, True, False, False, False, False
             End With
             GrChild.Closed = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             GrChild.Properties("BrushStyle") = "Solid"
'             GrChild.Properties("BrushColor") = RGB(255, 255, 255)
             GrChild.Properties("BrushColor") = BColor
             Set GrChild = Gr.Graphics.Add(gkGraphic)
                       GrChild.Cosmetic = True
             With GrChild.Vertices
                 .Add X(3), Y(3), 0, True, True, False, False, False, False
                 .Add X(4), Y(4), 0, True, True, False, False, False, False
                 .Add X(5), Y(5), 0, False, True, False, False, False, False
                 .Add X(6), Y(6), 0, True, True, False, False, False, False
                 .Add X(11), Y(11), 0, False, True, False, False, False, False
                 .Add X(13), Y(13), 0, True, True, False, False, False, False
                 .Add X(12), Y(12), 0, False, True, False, False, False, False
                 .Add X(14), Y(14), 0, True, True, False, False, False, False
             End With
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '14
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(7), Y(7), 0#, X(15), Y(15), 0#, X(13), Y(13), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '15
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(8), Y(8), 0#, X(16), Y(16), 0#, X(14), Y(14), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '16
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(13), Y(13), 0#, X(17), Y(17), 0#, X(14), Y(14), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
        End If
'-------------------------------------------------------------
' View Top
        If ViewN = "Top" Then
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + Dw / 2, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             GrChild.Properties("BrushStyle") = "Solid"
'             GrChild.Properties("BrushColor") = RGB(255, 255, 255)
             GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                For i = 0 To 6
                    x0(i) = D / 2 * Cos(Pi / 3 * i)
                    y0(i) = D / 2 * Sin(Pi / 3 * i)
                    X(i) = X00 + x0(i) * Calp - y0(i) * Salp
                    Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
                   .Add X(i), Y(i), 0, True, True, False, False, False, False
                Next i
            End With
             GrChild.Closed = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + D / 2 * Sin(Pi / 3), Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2 - del, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            x0(7) = D / 2
            y0(7) = 0
            X(7) = X00 + x0(7) * Calp - y0(7) * Salp
            Y(7) = Y00 + x0(7) * Salp + y0(7) * Calp

           With Gr.Vertices
                .Item(1).X = X(7)
                .Item(1).Y = Y(7)
            End With
        End If
End Sub

Private Sub HexSlottedNut(Gr As Graphic, dd As Double, LThread As Double)
Dim D#, H#, S#, K#, J#, H1#, del#
        D = 1.84 * dd
        H = 1# * dd
        S = D * Cos(Pi / 6)
        K = D / 2 * (1 - Cos(Pi / 6)) * Tan(Pi / 6)
        J = 0.3 * dd
        H1 = 0.3 * dd
        del = 0.15 * dd
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim Salp#, Calp#, L#
Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
            Salp = (Y01 - Y00) / L
            Calp = (X01 - X00) / L
        End With
        If Abs(H - L) > 0.0001 Then
            X01 = X00 + H * Calp
            Y01 = Y00 + H * Salp
            With Gr.Vertices
                .Item(1).X = X01
                .Item(1).Y = Y01
                L = H
            End With
        End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Dim x0(41)
Dim y0(41)
Dim X(41)
Dim Y(41)

       x0(1) = 0#
       y0(1) = S / 2#

       x0(2) = x0(1)
       y0(2) = -y0(1)

       x0(3) = K
       y0(3) = D / 2#

       x0(4) = x0(3)
       y0(4) = -y0(3)

       x0(5) = H - K
       y0(5) = D / 2

       x0(6) = x0(5)
       y0(6) = -y0(5)

       x0(7) = H
       y0(7) = S / 2#

       x0(8) = x0(7)
       y0(8) = -y0(7)

       x0(9) = x0(3)
       y0(9) = D / 4

       x0(10) = x0(9)
       y0(10) = -y0(9)

       x0(11) = x0(5)
       y0(11) = D / 4#

       x0(12) = x0(11)
       y0(12) = -y0(11)

       x0(13) = 0#
       y0(13) = 3 * D / 8

       x0(14) = x0(13)
       y0(14) = -y0(13)

       x0(15) = H
       y0(15) = 3 * D / 8

       x0(16) = x0(15)
       y0(16) = -y0(15)

       x0(17) = 0
       y0(17) = 0

       x0(18) = H
       y0(18) = 0#
'#########################################################
       x0(19) = H
       y0(19) = y0(15) + J / 4
       x0(20) = H
       y0(20) = y0(15) - J / 4

       x0(21) = H - H1
       y0(21) = y0(19)
       x0(22) = x0(21)
       y0(22) = y0(20)

       x0(23) = H - H1 - J / 4
       y0(23) = y0(15)
'--------------------------------------------------------
       x0(24) = H
       y0(24) = y0(16) + J / 4
       x0(25) = H
       y0(25) = y0(16) - J / 4

       x0(26) = H - H1
       y0(26) = y0(24)
       x0(27) = x0(26)
       y0(27) = y0(25)

       x0(28) = x0(23)
       y0(28) = y0(16)

'--------------------------------------------------------
       x0(29) = H
       y0(29) = J / 2
       x0(30) = H
       y0(30) = -J / 2

       x0(31) = x0(21) + J / 4
       y0(31) = y0(29)
       x0(32) = x0(21) + J / 4
       y0(32) = y0(30)

       x0(33) = x0(23)
       y0(33) = 0#

' Thread
       x0(34) = H
       y0(34) = dd / 2

       x0(35) = x0(34)
       y0(35) = -y0(34)

       x0(36) = H + LThread - del
       y0(36) = dd / 2

       x0(37) = x0(36)
       y0(37) = -y0(36)

       x0(38) = H + LThread
       y0(38) = dd / 2 - del

       x0(39) = x0(38)
       y0(39) = -y0(38)

       x0(40) = H
       y0(40) = dd / 2 - del

       x0(41) = x0(40)
       y0(41) = -y0(40)

Dim i%
       For i = 1 To 41
          X(i) = X00 + x0(i) * Calp - y0(i) * Salp
          Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
        If ViewN = "Front" Then
            If LThread > 0.01 * dd Then
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(34), Y(34), 0, True, True, False, False, False, False
                    .Add X(36), Y(36), 0, True, True, False, False, False, False
                    .Add X(38), Y(38), 0, True, True, False, False, False, False
                    .Add X(39), Y(39), 0, True, True, False, False, False, False
                    .Add X(37), Y(37), 0, True, True, False, False, False, False
                    .Add X(35), Y(35), 0, True, True, False, False, False, False
                    .Add X(34), Y(34), 0, True, True, False, False, False, False
                End With
                GrChild.Closed = True
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                GrChild.Properties("BrushStyle") = "Solid"
                 GrChild.Properties("BrushColor") = BColor
               Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(36), Y(36), 0, False, True, False, False, False, False
                    .Add X(37), Y(37), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(40), Y(40), 0, True, True, False, False, False, False
                    .Add X(38), Y(38), 0, True, True, False, False, False, False
                    .Add X(41), Y(41), 0, False, True, False, False, False, False
                    .Add X(39), Y(39), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenColor") = PColor
            End If
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
            End With
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(9), Y(9), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, False, True, False, False, False, False
                .Add X(12), Y(12), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(3), Y(3), 0#, X(13), Y(13), 0#, X(9), Y(9), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(9), Y(9), 0#, X(17), Y(17), 0#, X(10), Y(10), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '16
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, X(14), Y(14), 0#, X(4), Y(4), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(5), Y(5), 0#, X(15), Y(15), 0#, X(11), Y(11), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(11), Y(11), 0#, X(18), Y(18), 0#, X(12), Y(12), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '16
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(12), Y(12), 0#, X(16), Y(16), 0#, X(6), Y(6), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
             With GrChild.Vertices
                .Add X(19), Y(19), 0, True, True, False, False, False, False
                .Add X(21), Y(21), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("PenWidth") = 0.02
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
             With GrChild.Vertices
                .Add X(20), Y(20), 0, True, True, False, False, False, False
                .Add X(22), Y(22), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(21), Y(21), 0#, X(23), Y(23), 0#, X(22), Y(22), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
             With GrChild.Vertices
                .Add X(24), Y(24), 0, True, True, False, False, False, False
                .Add X(26), Y(26), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
             With GrChild.Vertices
                .Add X(25), Y(25), 0, True, True, False, False, False, False
                .Add X(27), Y(27), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(26), Y(26), 0#, X(28), Y(28), 0#, X(27), Y(27), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
             With GrChild.Vertices
                .Add X(29), Y(29), 0, True, True, False, False, False, False
                .Add X(31), Y(31), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
             With GrChild.Vertices
                .Add X(30), Y(30), 0, True, True, False, False, False, False
                .Add X(32), Y(32), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(31), Y(31), 0#, X(33), Y(33), 0#, X(32), Y(32), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
        End If

        If ViewN = "Top" Then
' View Top
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                For i = 0 To 6
                    x0(i) = D / 2 * Cos(Pi / 3 * i)
                    y0(i) = D / 2 * Sin(Pi / 3 * i)
                    X(i) = X00 + x0(i) * Calp - y0(i) * Salp
                    Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
                   .Add X(i), Y(i), 0, True, True, False, False, False, False
                Next i
            End With
             GrChild.Closed = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             GrChild.Properties("BrushStyle") = "Solid"
'             GrChild.Properties("BrushColor") = RGB(255, 255, 255)
             GrChild.Properties("BrushColor") = BColor
             Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2 - del, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            x0(7) = D / 2
            y0(7) = 0
            X(7) = X00 + x0(7) * Calp - y0(7) * Salp
            Y(7) = Y00 + x0(7) * Salp + y0(7) * Calp

           With Gr.Vertices
                .Item(1).X = X(7)
                .Item(1).Y = Y(7)
            End With
Dim x1#, y1#, x2#, y2#, x3#, y3#, x4#, y4#, x5#, y5#, x6#, y6#, x7#, y7#
            x1 = D / 2
            y1 = 0#
            x2 = x1 - D / 4 * Sin(Pi / 6)
            y2 = y1 + D / 4 * Sin(Pi / 3)
            x4 = x2 + J / 2 * Sin(Pi / 6)
            y4 = y2 - J / 2 * Sin(Pi / 3)
            x5 = x2 - J / 2 * Sin(Pi / 6)
            y5 = y2 + J / 2 * Sin(Pi / 3)
Dim L1#, hx#

            L1 = Sqr((x4 - x5) * (x4 - x5) + (y4 - y5) * (y4 - y5))
            hx = Sqr(dd * dd / 4 - L1 * L1 / 4)
            x3 = x2 - (D / 2 * Sin(Pi / 3) - hx) * Sin(Pi / 3)
            y3 = y2 - (D / 2 * Sin(Pi / 3) - hx) * Sin(Pi / 6)
            x6 = x3 + J / 2 * Sin(Pi / 6)
            y6 = y3 - J / 2 * Sin(Pi / 3)
            x7 = x3 - J / 2 * Sin(Pi / 6)
            y7 = y3 + J / 2 * Sin(Pi / 3)
Dim x41#, y41#, x51#, y51#, x61#, y61#, x71#, y71#
Dim x42#, y42#, x52#, y52#, x62#, y62#, x72#, y72#
Dim xc#, yc#, xc1#, yc1#, xc2#, yc2#, xc3#, yc3#
            For i = 0 To 5
                x41 = x4 * Cos(Pi / 3 * i) - y4 * Sin(Pi / 3 * i)
                y41 = x4 * Sin(Pi / 3 * i) + y4 * Cos(Pi / 3 * i)
                x51 = x5 * Cos(Pi / 3 * i) - y5 * Sin(Pi / 3 * i)
                y51 = x5 * Sin(Pi / 3 * i) + y5 * Cos(Pi / 3 * i)
                x61 = x6 * Cos(Pi / 3 * i) - y6 * Sin(Pi / 3 * i)
                y61 = x6 * Sin(Pi / 3 * i) + y6 * Cos(Pi / 3 * i)
                x71 = x7 * Cos(Pi / 3 * i) - y7 * Sin(Pi / 3 * i)
                y71 = x7 * Sin(Pi / 3 * i) + y7 * Cos(Pi / 3 * i)
                x42 = X00 + x41 * Calp - y41 * Salp
                y42 = Y00 + x41 * Salp + y41 * Calp
                x52 = X00 + x51 * Calp - y51 * Salp
                y52 = Y00 + x51 * Salp + y51 * Calp
                x62 = X00 + x61 * Calp - y61 * Salp
                y62 = Y00 + x61 * Salp + y61 * Calp
                x72 = X00 + x71 * Calp - y71 * Salp
                y72 = Y00 + x71 * Salp + y71 * Calp
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                   .Add x42, y42, 0, True, True, False, False, False, False
                   .Add x62, y62, 0, True, True, False, False, False, False
                   .Add x52, y52, 0, False, True, False, False, False, False
                   .Add x72, y72, 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
               xc1 = x42
                yc1 = y42
                xc = D / 2 * Sin(Pi / 3) * Cos(Pi / 3 * i)
                yc = D / 2 * Sin(Pi / 3) * Sin(Pi / 3 * i)
                xc2 = X00 + xc * Calp - yc * Salp
                yc2 = Y00 + xc * Salp + yc * Calp
                x41 = x4 * Cos(Pi / 3 * i) + y4 * Sin(Pi / 3 * i)
                y41 = x4 * Sin(Pi / 3 * i) - y4 * Cos(Pi / 3 * i)
                xc3 = X00 + x41 * Calp - y41 * Salp
                yc3 = Y00 + x41 * Salp + y41 * Calp
                Set GrChild = Gr.Graphics.AddArcTriplePoint(xc1, yc1, 0, xc2, yc2, 0, xc3, yc3, 0)
                          GrChild.Cosmetic = True
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
            Next i
        End If
End Sub


Examples - %%PROJECT_NAME%%Nut2.frm

Nut2.frm

VERSION 5.00
Begin VB.Form frmSample
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Nuts"
   ClientHeight    =   3885
   ClientLeft      =   6420
   ClientTop       =   2910
   ClientWidth     =   5460
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   259
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   364
   StartUpPosition =   1  'CenterOwner
   Begin VB.TextBox txtLenThread
      Height          =   288
      Left            =   1680
      TabIndex        =   6
      Top             =   2847
      Width           =   855
   End
   Begin VB.ListBox List2
      Height          =   255
      ItemData        =   "Nut2.frx":0000
      Left            =   3960
      List            =   "Nut2.frx":000A
      TabIndex        =   5
      Top             =   120
      Width           =   1335
   End
   Begin VB.ListBox List1
      Height          =   1620
      ItemData        =   "Nut2.frx":001A
      Left            =   240
      List            =   "Nut2.frx":002D
      TabIndex        =   4
      Top             =   480
      Width           =   2295
   End
   Begin VB.TextBox txtdd
      Height          =   285
      Left            =   1680
      TabIndex        =   3
      Top             =   2400
      Width           =   855
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   4080
      TabIndex        =   0
      Top             =   3360
      Width           =   1212
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   2640
      TabIndex        =   1
      Top             =   3360
      Width           =   1215
   End
   Begin VB.Image PicPreview
      BorderStyle     =   1  'Fixed Single
      Height          =   2640
      Left            =   2700
      Stretch         =   -1  'True
      Top             =   465
      Width           =   2595
   End
   Begin VB.Label Label2
      Caption         =   "Nut Type :"
      Height          =   255
      Left            =   240
      TabIndex        =   8
      Top             =   120
      Width           =   1335
   End
   Begin VB.Label Label5
      Alignment       =   1  'Right Justify
      Caption         =   "Thread Lenght (Lt) :"
      Height          =   255
      Left            =   120
      TabIndex        =   7
      Top             =   2880
      Width           =   1455
      WordWrap        =   -1  'True
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "Diameter (d) :"
      Height          =   255
      Left            =   360
      TabIndex        =   2
      Top             =   2400
      Width           =   1215
   End
End
Attribute VB_Name = "frmSample"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Me.Hide
End Sub

Private Sub Form_Load()
Dim i%, iDef%
    For i = 0 To List1.ListCount - 1
        If List1.List(i) = TypeN Then iDef = i
    Next i
    List1.ListIndex = iDef
    For i = 0 To List2.ListCount - 1
        If List2.List(i) = ViewN Then iDef = i
    Next i
    List2.ListIndex = iDef

  '  HexNut.Visible = False
  '  HexFlangeNut.Visible = False
  '  HexSlottedNut.Visible = False
  '  LowCrownNut.Visible = False
  '  SquareNut.Visible = False

'    If List1.Text = "HexNut" Then HexNut.Visible = True
'    If List1.Text = "HexFlangeNut" Then HexFlangeNut.Visible = True
'    If List1.Text = "HexSlottedNut" Then HexSlottedNut.Visible = True
'    If List1.Text = "LowCrownNut" Then LowCrownNut.Visible = True
'    If List1.Text = "SquareNut" Then SquareNut.Visible = True
    If List1.Text = "HexNut" Then PicPreview.Picture = LoadResPicture(101, 0)
    If List1.Text = "HexFlangeNut" Then PicPreview.Picture = LoadResPicture(102, 0)
    If List1.Text = "HexSlottedNut" Then PicPreview.Picture = LoadResPicture(103, 0)
    If List1.Text = "LowCrownNut" Then PicPreview.Picture = LoadResPicture(104, 0)
    If List1.Text = "SquareNut" Then PicPreview.Picture = LoadResPicture(105, 0)

End Sub

Private Sub Label3_Click()

End Sub

Private Sub List1_Click()
'    HexNut.Visible = False
'    HexFlangeNut.Visible = False
'    HexSlottedNut.Visible = False
'    LowCrownNut.Visible = False
'    SquareNut.Visible = False

'    If List1.Text = "HexNut" Then HexNut.Visible = True
'    If List1.Text = "HexFlangeNut" Then HexFlangeNut.Visible = True
'    If List1.Text = "HexSlottedNut" Then HexSlottedNut.Visible = True
'    If List1.Text = "LowCrownNut" Then LowCrownNut.Visible = True
'    If List1.Text = "SquareNut" Then SquareNut.Visible = True
    If List1.Text = "HexNut" Then PicPreview.Picture = LoadResPicture(101, 0)
    If List1.Text = "HexFlangeNut" Then PicPreview.Picture = LoadResPicture(102, 0)
    If List1.Text = "HexSlottedNut" Then PicPreview.Picture = LoadResPicture(103, 0)
    If List1.Text = "LowCrownNut" Then PicPreview.Picture = LoadResPicture(104, 0)
    If List1.Text = "SquareNut" Then PicPreview.Picture = LoadResPicture(105, 0)

End Sub


Examples - Tolerance Symbol Regen - ChooseFont.frm

ChooseFont.frm

Tolerance Symbol Regen Example

VERSION 5.00
Begin VB.Form frmChooseFont
   BackColor       =   &H8000000A&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Font"
   ClientHeight    =   2670
   ClientLeft      =   6045
   ClientTop       =   6330
   ClientWidth     =   4305
   BeginProperty Font
      Name            =   "Arial"
      Size            =   12
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2670
   ScaleWidth      =   4305
   Begin VB.CommandButton Command1
      Caption         =   "OK"
      BeginProperty Font
         Name            =   "Microsoft Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2640
      TabIndex        =   5
      Top             =   375
      Width           =   1095
   End
   Begin VB.CommandButton Command2
      Caption         =   "Cancel"
      BeginProperty Font
         Name            =   "Microsoft Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2640
      TabIndex        =   4
      Top             =   960
      Width           =   1095
   End
   Begin VB.Frame Frame2
      Caption         =   "Sample"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   855
      Left            =   2280
      TabIndex        =   2
      Top             =   1680
      Width           =   1935
      Begin VB.TextBox Text1
         Alignment       =   2  'Center
         Height          =   390
         Left            =   120
         TabIndex        =   3
         TabStop         =   0   'False
         Text            =   "Text1"
         Top             =   360
         Width           =   1695
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "Font"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   2415
      Left            =   240
      TabIndex        =   1
      Top             =   120
      Width           =   1935
      Begin VB.ListBox List1
         BeginProperty Font
            Name            =   "Arial"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   1950
         ItemData        =   "ChooseFont.frx":0000
         Left            =   120
         List            =   "ChooseFont.frx":0002
         TabIndex        =   0
         Top             =   360
         Width           =   1695
      End
   End
End
Attribute VB_Name = "frmChooseFont"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
    TextF = Text1.Font
    Me.Hide
End Sub

Private Sub Command2_Click()
    Me.Hide
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Me.Hide
End Sub

Private Sub Form_Load()
Dim i%, iDef%  ' Declare variable.
    For i = 0 To Screen.FontCount - 1  ' Determine number of fonts.
        List1.AddItem Screen.Fonts(i)  ' Put each font into list box.
        If Screen.Fonts(i) = TextF Then iDef = i
    Next i
    Text1.Font.Italic = False
   Text1.Font.Size = 12
    List1.ListIndex = iDef
    Text1.Text = "AaBbYyZz"

End Sub

Private Sub List1_Click()
    Text1.Font.Italic = False
    Text1.Font.Size = 12
    Text1.Font = List1.Text
    Text1.Text = "AaBbYyZz"
End Sub


Examples - Tolerance Symbol Regen - DatRef.bas

DatRef.bas

Tolerance Symbol Regen Example

Attribute VB_Name = "modDatRef"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
Global Im11$
Global Im12$
Global Im13$
Global Im14$
Global Im15$
Global Im16$
Global Im17$
Global Im18$

Global ImF11 As String
Global ImF12 As String
Global ImF13 As String
Global ImF14 As String
Global ImF15 As String
Global ImF16 As String
Global ImF17 As String
Global ImF18 As String

Global Str11 As String
Global Str12 As String
Global Str13 As String
Global Str14 As String
Global Str15 As String

Global Im21$
Global Im22$
Global Im23$
Global Im24$
Global Im25$
Global Im26$
Global Im27$
Global Im28$

Global ImF21 As String
Global ImF22 As String
Global ImF23 As String
Global ImF24 As String
Global ImF25 As String
Global ImF26 As String
Global ImF27 As String
Global ImF28 As String

Global Str21 As String
Global Str22 As String
Global Str23 As String
Global Str24 As String
Global Str25 As String

Global Im31$
Global ImF31 As String
Global Str31 As String

Global Str41 As String

Global SymTxtHeight As Double

Global TextF As String

Global Im1%
Global Im2%
Global Im3%
Global Str1 As String
Global Str2 As String
Global Str3 As String
Global Str4 As String
Global Len0 As Double
Global R0#
Global strPath$
Global Const pi = 3.14159

Global ClIm1%
Global ClIm2%
Global ClIm3%

Global App As Application

' DLL Entry point
Sub Main()
    Im11 = Chr(98)
    Im12 = Chr(110)
    Im13 = Chr(109)
    Im14 = ""
    Im15 = ""
    Im16 = ""
    Im17 = ""
    Im18 = ""

    ImF11 = "gdt.shx"
    ImF12 = "gdt.shx"
    ImF13 = "gdt.shx"
    ImF14 = "gdt.shx"
    ImF15 = "gdt.shx"
    ImF16 = "gdt.shx"
    ImF17 = "gdt.shx"
    ImF18 = "gdt.shx"

    Str11 = "0.000"
    Str12 = ""
    Str13 = "A"
    Str14 = "B"
    Str15 = "C"

    Im21 = ""
    Im22 = ""
    Im23 = ""
    Im24 = ""
    Im25 = ""
    Im26 = ""
    Im27 = ""
    Im28 = ""

    ImF21 = "gdt.shx"
    ImF22 = "gdt.shx"
    ImF23 = "gdt.shx"
    ImF24 = "gdt.shx"
    ImF25 = "gdt.shx"
    ImF26 = "gdt.shx"
    ImF27 = "gdt.shx"
    ImF28 = "gdt.shx"

    Str21 = ""
    Str22 = ""
    Str23 = ""
    Str24 = ""
    Str25 = ""

    Im31 = ""
    ImF31 = "gdt.shx"
    Str31 = ""

    Str41 = ""

    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0

    Im1 = 1
    Im2 = 2
    Im3 = 2
    Str1 = "0.000"
    Str2 = "A"
    Str3 = "B"
    Str4 = "C"
    R0 = 0.25
    SymTxtHeight = 0.3
    TextF = "Times New Roman"
End Sub


Examples - Tolerance Symbol Regen - DatRef.cls

DatRef.cls

Tolerance Symbol Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ANSI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2000                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
    ' Table-1
Const idImg11 = 11
Const idImg12 = 12
Const idImg13 = 13
Const idImg14 = 14
Const idImg15 = 15
Const idImg16 = 16
Const idImg17 = 17
Const idImg18 = 18

Const idImgFont11 = 51
Const idImgFont12 = 52
Const idImgFont13 = 53
Const idImgFont14 = 54
Const idImgFont15 = 55
Const idImgFont16 = 56
Const idImgFont17 = 57
Const idImgFont18 = 58

Const idTxt11 = 101
Const idTxt12 = 102
Const idTxt13 = 103
Const idTxt14 = 104
Const idTxt15 = 105

    ' Table-2
Const idImg21 = 21
Const idImg22 = 22
Const idImg23 = 23
Const idImg24 = 24
Const idImg25 = 25
Const idImg26 = 26
Const idImg27 = 27
Const idImg28 = 28

Const idImgFont21 = 61
Const idImgFont22 = 62
Const idImgFont23 = 63
Const idImgFont24 = 64
Const idImgFont25 = 65
Const idImgFont26 = 66
Const idImgFont27 = 67
Const idImgFont28 = 68

Const idTxt21 = 201
Const idTxt22 = 202
Const idTxt23 = 203
Const idTxt24 = 204
Const idTxt25 = 205

    ' Table-3
Const idImg31 = 31

Const idImgFont31 = 71

Const idTxt31 = 301

    ' Table-4
Const idTxt41 = 401

    ' Scale
Const idSymTxtHeight = 500

    ' Text Font
Const idTextFont = 501

    ' LinearUnitName
Const idUnitName = 502

'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 49
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "Geometric Tolerance"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{FDB6F1C4-9631-11d1-A40A-0000B465872B}"

End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)

'-----------------------------------------------------
'Begin Table-1
    Names(0) = "Image11"
    Types(0) = typeString
    IDs(0) = idImg11
    Defaults(0) = Chr(98)

    Names(1) = "Image12"
    Types(1) = typeString
    IDs(1) = idImg12
    Defaults(1) = Chr(110)

    Names(2) = "Image13"
    Types(2) = typeString
    IDs(2) = idImg13
    Defaults(2) = Chr(109)

    Names(3) = "Image14"
    Types(3) = typeString
    IDs(3) = idImg14
    Defaults(3) = ""

    Names(4) = "Image15"
    Types(4) = typeString
    IDs(4) = idImg15
    Defaults(4) = ""

    Names(5) = "Image16"
    Types(5) = typeString
    IDs(5) = idImg16
    Defaults(5) = ""

    Names(6) = "Image17"
    Types(6) = typeString
    IDs(6) = idImg17
    Defaults(6) = ""

    Names(7) = "Image18"
    Types(7) = typeString
    IDs(7) = idImg18
    Defaults(7) = ""

' Fonts for Imiges for the Table-1

    Names(30) = "ImageFont11"
    Types(30) = typeString
    IDs(30) = idImgFont11
    Defaults(30) = "gdt.shx"

    Names(31) = "ImageFont12"
    Types(31) = typeString
    IDs(31) = idImgFont12
    Defaults(31) = "gdt.shx"

    Names(32) = "ImageFont13"
    Types(32) = typeString
    IDs(32) = idImgFont13
    Defaults(32) = "gdt.shx"

    Names(33) = "ImageFont14"
    Types(33) = typeString
    IDs(33) = idImgFont14
    Defaults(33) = "gdt.shx"

    Names(34) = "ImageFont15"
    Types(34) = typeString
    IDs(34) = idImgFont15
    Defaults(34) = "gdt.shx"

    Names(35) = "ImageFont16"
    Types(35) = typeString
    IDs(35) = idImgFont16
    Defaults(35) = "gdt.shx"

    Names(36) = "ImageFont17"
    Types(36) = typeString
    IDs(36) = idImgFont17
    Defaults(36) = "gdt.shx"

    Names(37) = "ImageFont18"
    Types(37) = typeString
    IDs(37) = idImgFont18
    Defaults(37) = "gdt.shx"

' End fonts for images for the Table-1

    Names(8) = "Text11"
    Types(8) = typeString
    IDs(8) = idTxt11
    Defaults(8) = "0.000"

    Names(9) = "Text12"
    Types(9) = typeString
    IDs(9) = idTxt12
    Defaults(9) = ""

    Names(10) = "Text13"
    Types(10) = typeString
    IDs(10) = idTxt13
    Defaults(10) = "A"

    Names(11) = "Text14"
    Types(11) = typeString
    IDs(11) = idTxt14
    Defaults(11) = "B"

    Names(12) = "Text15"
    Types(12) = typeString
    IDs(12) = idTxt15
    Defaults(12) = "C"
'End Table-1
'-----------------------------------------------------------

'-----------------------------------------------------
'Begin Table-2
    Names(13) = "Image21"
    Types(13) = typeString
    IDs(13) = idImg21
    Defaults(13) = ""

    Names(14) = "Image22"
    Types(14) = typeString
    IDs(14) = idImg22
    Defaults(14) = ""

    Names(15) = "Image23"
    Types(15) = typeString
    IDs(15) = idImg23
    Defaults(15) = ""

    Names(16) = "Image24"
    Types(16) = typeString
    IDs(16) = idImg24
    Defaults(16) = ""

    Names(17) = "Image25"
    Types(17) = typeString
    IDs(17) = idImg25
    Defaults(17) = ""

    Names(18) = "Image26"
    Types(18) = typeString
    IDs(18) = idImg26
    Defaults(18) = ""

    Names(19) = "Image27"
    Types(19) = typeString
    IDs(19) = idImg27
    Defaults(19) = ""

    Names(20) = "Image28"
    Types(20) = typeString
    IDs(20) = idImg28
    Defaults(20) = ""

' Fonts for Imiges for the Table-2

    Names(38) = "ImageFont21"
    Types(38) = typeString
    IDs(38) = idImgFont21
    Defaults(38) = "gdt.shx"

    Names(39) = "ImageFont22"
    Types(39) = typeString
    IDs(39) = idImgFont22
    Defaults(39) = "gdt.shx"

    Names(40) = "ImageFont23"
    Types(40) = typeString
    IDs(40) = idImgFont23
    Defaults(40) = "gdt.shx"

    Names(41) = "ImageFont24"
    Types(41) = typeString
    IDs(41) = idImgFont24
    Defaults(41) = "gdt.shx"

    Names(42) = "ImageFont25"
    Types(42) = typeString
    IDs(42) = idImgFont25
    Defaults(42) = "gdt.shx"

    Names(43) = "ImageFont26"
    Types(43) = typeString
    IDs(43) = idImgFont26
    Defaults(43) = "gdt.shx"

    Names(44) = "ImageFont27"
    Types(44) = typeString
    IDs(44) = idImgFont27
    Defaults(44) = "gdt.shx"

    Names(45) = "ImageFont28"
    Types(45) = typeString
    IDs(45) = idImgFont28
    Defaults(45) = "gdt.shx"

' End fonts for images for the Table-2

    Names(21) = "Text21"
    Types(21) = typeString
    IDs(21) = idTxt21
    Defaults(21) = ""

    Names(22) = "Text22"
    Types(22) = typeString
    IDs(22) = idTxt22
    Defaults(22) = ""

    Names(23) = "Text23"
    Types(23) = typeString
    IDs(23) = idTxt23
    Defaults(23) = ""

    Names(24) = "Text24"
    Types(24) = typeString
    IDs(24) = idTxt24
    Defaults(24) = ""

    Names(25) = "Text25"
    Types(25) = typeString
    IDs(25) = idTxt25
    Defaults(25) = ""

'End Table-2
'-----------------------------------------------------------

'-----------------------------------------------------
'Begin Table-3
    Names(26) = "Image31"
    Types(26) = typeString
    IDs(26) = idImg31
    Defaults(26) = ""

' Fonts for Imiges for the Table-3

    Names(46) = "ImageFont31"
    Types(46) = typeString
    IDs(46) = idImgFont31
    Defaults(46) = "gdt.shx"

' End fonts for images for the Table-3

    Names(27) = "Text31"
    Types(27) = typeString
    IDs(27) = idTxt31
    Defaults(27) = ""

'End Table-3
'-----------------------------------------------------------

'-----------------------------------------------------
'Begin Table-4

    Names(28) = "Text41"
    Types(28) = typeString
    IDs(28) = idTxt41
    Defaults(28) = ""

'End Table-4
'-----------------------------------------------------------

 '-----------------------------------------------------
'Begin Scale

    Names(29) = "SymTxtHeight"
'    Types(29) = typeString
    Types(29) = typeDouble
    IDs(29) = idSymTxtHeight
'    Defaults(29) = "0.3"
    Defaults(29) = 0.3

'End Scale
'-----------------------------------------------------------
'Begin TextFont

    Names(47) = "FontTxt"
    Types(47) = typeString
    IDs(47) = idTextFont
    Defaults(47) = "Times New Roman"

'End TextFont

'Begin TextFont

    Names(48) = "UnitName"
    Types(48) = typeString
    IDs(48) = idUnitName
    Defaults(48) = "in"

'End TextFont

    GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmDatRef
    Names(0) = frmDatRef.Caption
    Unload frmDatRef

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
    GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal theGraphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed

        Dim grfThis As Graphic
        Set grfThis = theGraphic
        Set App = grfThis.Application
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
'            With frmDatRef
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
'                On Error Resume Next

'            End With

' ------------------------------------------------------------------------

                   ' Table-1
            grfThis.Properties("Image11") = Im11
            grfThis.Properties("Image12") = Im12
            grfThis.Properties("Image13") = Im13
            grfThis.Properties("Image14") = Im14
            grfThis.Properties("Image15") = Im15
            grfThis.Properties("Image16") = Im16
            grfThis.Properties("Image17") = Im17
            grfThis.Properties("Image18") = Im18

            grfThis.Properties("ImageFont11") = ImF11
            grfThis.Properties("ImageFont12") = ImF12
            grfThis.Properties("ImageFont13") = ImF13
            grfThis.Properties("ImageFont14") = ImF14
            grfThis.Properties("ImageFont15") = ImF15
            grfThis.Properties("ImageFont16") = ImF16
            grfThis.Properties("ImageFont17") = ImF17
            grfThis.Properties("ImageFont18") = ImF18

            grfThis.Properties("Text11") = Str11
            grfThis.Properties("Text12") = Str12
            grfThis.Properties("Text13") = Str13
            grfThis.Properties("Text14") = Str14
            grfThis.Properties("Text15") = Str15

                   ' Table-2
            grfThis.Properties("Image21") = Im21
            grfThis.Properties("Image22") = Im22
            grfThis.Properties("Image23") = Im23
            grfThis.Properties("Image24") = Im24
            grfThis.Properties("Image25") = Im25
            grfThis.Properties("Image26") = Im26
            grfThis.Properties("Image27") = Im27
            grfThis.Properties("Image28") = Im28

            grfThis.Properties("ImageFont21") = ImF21
            grfThis.Properties("ImageFont22") = ImF22
            grfThis.Properties("ImageFont23") = ImF23
            grfThis.Properties("ImageFont24") = ImF24
            grfThis.Properties("ImageFont25") = ImF25
            grfThis.Properties("ImageFont26") = ImF26
            grfThis.Properties("ImageFont27") = ImF27
            grfThis.Properties("ImageFont28") = ImF28

            grfThis.Properties("Text21") = Str21
            grfThis.Properties("Text22") = Str22
            grfThis.Properties("Text23") = Str23
            grfThis.Properties("Text24") = Str24
            grfThis.Properties("Text25") = Str25

                   ' Table-3
            grfThis.Properties("Image31") = Im31
            grfThis.Properties("ImageFont31") = ImF31
            grfThis.Properties("Text31") = Str31

                   ' Table-4
            grfThis.Properties("Text41") = Str41

                   ' Scale symbol
            grfThis.Properties("SymTxtHeight") = SymTxtHeight

                   ' Text Font
            If frmDatRef.CheckFont.Value = 1 Then
                TextF = grfThis.Drawing.Properties("TextFont")
            End If
            grfThis.Properties("FontTxt") = TextF

        Else
            'Property page is about to be opened
            'Make sure the form is loaded
'             Load frmDatRef
            Im11 = Chr(98)
            Im12 = Chr(110)
            Im13 = Chr(109)
            Im14 = ""
            Im15 = ""
            Im16 = ""
            Im17 = ""
            Im18 = ""
            ImF11 = "gdt.shx"
            ImF12 = "gdt.shx"
            ImF13 = "gdt.shx"
            Str11 = "0.000"
            Str12 = ""
            Str13 = "A"
            Str14 = "B"
            Str15 = "C"

            Im21 = ""
            Im22 = ""
            Im23 = ""
            Im24 = ""
            Im25 = ""
            Im26 = ""
            Im27 = ""
            Im28 = ""

            Str21 = ""
            Str22 = ""
            Str23 = ""
            Str24 = ""
            Str25 = ""

            Im31 = ""
            Str31 = ""

            Str41 = ""

            SymTxtHeight = 0.3

            TextF = "Times New Roman"
                   ' Table-1
            On Error Resume Next
            Im11 = grfThis.Properties("Image11")
            Im12 = grfThis.Properties("Image12")
            Im13 = grfThis.Properties("Image13")
            Im14 = grfThis.Properties("Image14")
            Im15 = grfThis.Properties("Image15")
            Im16 = grfThis.Properties("Image16")
            Im17 = grfThis.Properties("Image17")
            Im18 = grfThis.Properties("Image18")

            ImF11 = grfThis.Properties("ImageFont11")
            ImF12 = grfThis.Properties("ImageFont12")
            ImF13 = grfThis.Properties("ImageFont13")
            ImF14 = grfThis.Properties("ImageFont14")
            ImF15 = grfThis.Properties("ImageFont15")
            ImF16 = grfThis.Properties("ImageFont16")
            ImF17 = grfThis.Properties("ImageFont17")
            ImF18 = grfThis.Properties("ImageFont18")

            Str11 = grfThis.Properties("Text11")
            Str12 = grfThis.Properties("Text12")
            Str13 = grfThis.Properties("Text13")
            Str14 = grfThis.Properties("Text14")
            Str15 = grfThis.Properties("Text15")

                   ' Table-2
            Im21 = grfThis.Properties("Image21")
            Im22 = grfThis.Properties("Image22")
            Im23 = grfThis.Properties("Image23")
            Im24 = grfThis.Properties("Image24")
            Im25 = grfThis.Properties("Image25")
            Im26 = grfThis.Properties("Image26")
            Im27 = grfThis.Properties("Image27")
            Im28 = grfThis.Properties("Image28")

            ImF21 = grfThis.Properties("ImageFont21")
            ImF22 = grfThis.Properties("ImageFont22")
            ImF23 = grfThis.Properties("ImageFont23")
            ImF24 = grfThis.Properties("ImageFont24")
            ImF25 = grfThis.Properties("ImageFont25")
            ImF26 = grfThis.Properties("ImageFont26")
            ImF27 = grfThis.Properties("ImageFont27")
            ImF28 = grfThis.Properties("ImageFont28")

            Str21 = grfThis.Properties("Text21")
            Str22 = grfThis.Properties("Text22")
            Str23 = grfThis.Properties("Text23")
            Str24 = grfThis.Properties("Text24")
            Str25 = grfThis.Properties("Text25")

                   ' Table-3
            Im31 = grfThis.Properties("Image31")
            ImF31 = grfThis.Properties("ImageFont31")
            Str31 = grfThis.Properties("Text31")

                   ' Table-4
            Str41 = grfThis.Properties("Text41")

                   ' Scale Symbol
            SymTxtHeight = grfThis.Properties("SymTxtHeight")

                    'Text Font
            TextF = grfThis.Properties("FontTxt")

            Load frmDatRef
        End If

''        Set App = Nothing

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
'            MsgBox "Error in PageControls: " & Err.Description
        End If
''        Set App = Nothing
        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmDatRef
        Set App = Nothing
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmDatRef
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal theGraphic As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If

    On Error GoTo Failed
'    Dim App As Object
    Dim grfThis As Graphic
    Set grfThis = theGraphic
'    Set App = grfThis.Application
'    strPath = App.Path & "\SDKBitMap\"
    'New Graphic being created
'Dim R#
'    R = CDbl(ScaleSymTxt) * R0
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "lower left" corner
    grfThis.Vertices.Add 0#, 0#, 0#, False, True, False, True, False
    'Second Vertex is "lower right" corner
    grfThis.Vertices.Add 4#, 0#, 0#, False, True, False, True, False
    'Third Vertex is "upper right" corner
'    grfThis.Vertices.Add 4#, R, 0#, False, False, False, False, False
    'Fourth Vertex is "upper left" corner
'    grfThis.Vertices.Add 0#, R, 0#, False, False, False, False, False
     '5 Vertex is editable "lower left" corner
'    grfThis.Vertices.Add 0#, 0#, 0#, False, False, False, False, False
    '6 Vertex is editable "lower right" corner
'    grfThis.Vertices.Add 4#, 0#, 0#, False, False, False, False, False
    '7 Vertex is editable "upper right" corner
'    grfThis.Vertices.Add 4#, R, 0#, False, False, False, False, False
    '8 Vertex is editable "upper left" corner
'    grfThis.Vertices.Add 0#, R, 0#, False, False, False, False, False
   Len0 = 4#
   grfThis.Properties("LimitVertices") = 2
    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal theGraphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal theGraphic As Object)
Dim Ver As Vertex
LLL:        'Setup error handler
        On Error GoTo Failed

        'Set up lock (prevent recursion)
        Dim LockCount&
        Dim grfThis As Graphic
        Set grfThis = theGraphic
'        grfThis.Properties("PenStyle") = "CONTINUOUS"
        ''On Error Resume Next
        ''grfThis.Properties("PenStyle") = "CONTINUOUS"
        ''Err.Clear
        ''On Error GoTo Failed

Dim NameUnit$
        NameUnit = grfThis.Drawing.Properties("LinearUnitName")
        If NameUnit = "mm" And grfThis.Properties("UnitName") = "in" Then
            grfThis.Properties("UnitName") = "mm"
            grfThis.Properties("SymTxtHeight") = grfThis.Properties("SymTxtHeight") * 25.4
        End If
If grfThis.Vertices.Count = 0 Then
    'First Vertex is "lower left" corner
    grfThis.Vertices.Add 0#, 0#, 0#, False, True, False, True, False
    'Second Vertex is "lower right" corner
    grfThis.Vertices.Add 4#, 0#, 0#, False, False, False, False, False
End If
R0 = 0.25

        LockCount& = grfThis.RegenLock
'MsgBox (grfThis.Drawing.Properties("LinearUnitName"))

        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
                   ' Table-1
            With grfThis
                Im11 = .Properties("Image11")
                Im12 = .Properties("Image12")
                Im13 = .Properties("Image13")
                Im14 = .Properties("Image14")
                Im15 = .Properties("Image15")
                Im16 = .Properties("Image16")
                Im17 = .Properties("Image17")
                Im18 = .Properties("Image18")
                ImF11 = .Properties("ImageFont11")
                ImF12 = .Properties("ImageFont12")
                ImF13 = .Properties("ImageFont13")
                ImF14 = .Properties("ImageFont14")
                ImF15 = .Properties("ImageFont15")
                ImF16 = .Properties("ImageFont16")
                ImF17 = .Properties("ImageFont17")
                ImF18 = .Properties("ImageFont18")
                Str11 = .Properties("Text11")
                Str12 = .Properties("Text12")
                Str13 = .Properties("Text13")
                Str14 = .Properties("Text14")
                Str15 = .Properties("Text15")

                       ' Table-2
                Im21 = .Properties("Image21")
                Im22 = .Properties("Image22")
                Im23 = .Properties("Image23")
                Im24 = .Properties("Image24")
                Im25 = .Properties("Image25")
                Im26 = .Properties("Image26")
                Im27 = .Properties("Image27")
                Im28 = .Properties("Image28")
                ImF21 = .Properties("ImageFont21")
                ImF22 = .Properties("ImageFont22")
                ImF23 = .Properties("ImageFont23")
                ImF24 = .Properties("ImageFont24")
                ImF25 = .Properties("ImageFont25")
                ImF26 = .Properties("ImageFont26")
                ImF27 = .Properties("ImageFont27")
                ImF28 = .Properties("ImageFont28")
                Str21 = .Properties("Text21")
                Str22 = .Properties("Text22")
                Str23 = .Properties("Text23")
                Str24 = .Properties("Text24")
                Str25 = .Properties("Text25")

                       ' Table-3
                Im31 = .Properties("Image31")
                ImF31 = .Properties("ImageFont31")
                Str31 = .Properties("Text31")

                       ' Table-4
                Str41 = .Properties("Text41")

                       ' Scale Symbol
                SymTxtHeight = .Properties("SymTxtHeight")
                    ' Text Font
                TextF = .Properties("FontTxt").Value
            End With

Dim Col As Long
        Col = grfThis.Properties("PenColor")

Dim R#
            R = SymTxtHeight * 0.625
            'Delete any previous cosmetic children
            grfThis.Graphics.Clear gfCosmetic

            Dim boolHandleMoved As Boolean
            'Add child Graphics
            Dim grfChild As Graphic
            Dim X0#, Y0#, X1#, Y1#, T#
Dim Z0#
            With grfThis.Vertices
                X0# = .Item(0).X
                Y0# = .Item(0).Y
                Z0# = .Item(0).Z
            End With

       Dim Salp#, Calp#, l#
            Dim X00#, Y00#, X01#, Y01#
            With grfThis.Vertices
                X00 = .Item(0).X
                Y00 = .Item(0).Y
                X01 = .Item(1).X
                Y01 = .Item(1).Y
                l = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
                Salp = (Y01 - Y00) / l
                Calp = (X01 - X00) / l
            End With
Dim alp#
            alp = Angle(Salp, Calp)
Dim i As Integer
Dim Xb#, Yb#
Dim Ymid#, Xb1#
Dim Symb As String

  If Mid(Im11, 1, 1) = Mid(Im21, 1, 1) And Im11 <> "" Then
    Ymid = Y0 - R
  Else
    Ymid = Y0
  End If
' -------------------------------------------------------------
 Dim D#
 D = 2# * R
 If Im11 <> "" Then

     Symb = Mid(Im11, 1, 1)
     If Mid(Im11, 1, 1) = Chr(116) Then
        Set grfChild = grfThis.Graphics.AddText(Symb, X0 + 0.08 * R, Ymid + 0.75 * D, Z0, 0.55 * D)
     Else
        Set grfChild = grfThis.Graphics.AddText(Symb, X0 + 0.1 * R, Ymid + 0.75 * D, Z0, 0.7 * D)
     End If
     With grfChild
        .Properties("TextFont") = ImF11 '"gdt.shx"
        .Properties("TextStyle") = 0
        .Properties("PenColor") = Col
        .Cosmetic = True
    End With
 Else
   Xb = X0
   Yb = Y0
   GoTo L1
 End If

'------------------------------------------------------
        Set grfChild = grfThis.Graphics.Add(11)
        With grfChild.Vertices
            .Add X0 + D, Y0, Z0
            .Add X0 + D, Y0 + D, Z0
        End With
                grfChild.Properties("PenColor") = Col
                grfChild.Cosmetic = True
'--------------------------------------------------------------

 Xb = X0 + D
 Yb = Y0
 Xb1 = Xb
L1:
 If Mid(Im12, 1, 1) = Chr(110) Then
    Symb = Mid(Im12, 1, 1)
    Set grfChild = grfThis.Graphics.AddText(Symb, Xb + 0.15 * D, Yb + 0.75 * D, Z0, 0.75 * D)
     With grfChild
        .Properties("TextFont") = ImF12 '"gdt.shx"
        .Properties("TextStyle") = 0
        .Properties("PenColor") = Col
        .Cosmetic = True
    End With

    Xb = Xb + D
    Yb = Y0
 End If
'---------------------------------------------------------------
' Text Fild - Text1=Str1
 If Len(Str11) > 0 Then
    If Im12 <> "" Then
        Set grfChild = grfThis.Graphics.AddText(Str11, Xb - 0.3 * R, Yb + 0.9 * D, Z0, 0.8 * D, 0)
    Else
        Set grfChild = grfThis.Graphics.AddText(Str11, Xb + 0.2 * R, Yb + 0.9 * D, Z0, 0.8 * D, 0)
    End If
     With grfChild
        .Properties("TextFont") = TextF '"gdt.shx"
        .Properties("TextStyle") = 0
        .Properties("PenColor") = Col
        .Cosmetic = True
        Xb = .CalcBoundingBox.Max.X
    End With
    Yb = Y0
 End If
' ---------------------------------------------------------
 If Im13 <> "" Then
    Symb = Mid(Im13, 1, 1)
    Set grfChild = grfThis.Graphics.AddText(Symb, Xb + 0.1 * R, Yb + 0.75 * D, Z0, 0.7 * D)
     With grfChild
        .Properties("TextFont") = ImF13 '"gdt.shx"
        .Properties("TextStyle") = 0
        .Properties("PenColor") = Col
        .Cosmetic = True
    End With
    Xb = Xb + D
    Yb = Y0
 End If
'------------------------------------------------------
        Set grfChild = grfThis.Graphics.Add(11)
        With grfChild.Vertices
            .Add Xb, Y0, Z0
            .Add Xb, Y0 + D, Z0
        End With
                grfChild.Properties("PenColor") = Col
                grfChild.Cosmetic = True
'--------------------------------------------------------------

' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Table-1  Datum-2
 If Mid(Im14, 1, 1) = Chr(110) Then

    Symb = Mid(Im14, 1, 1)
    Set grfChild = grfThis.Graphics.AddText(Symb, Xb + 0.15 * D, Yb + 0.75 * D, Z0, 0.75 * D)
     With grfChild
        .Properties("TextFont") = ImF14 '"gdt.shx"
        .Properties("TextStyle") = 0
        .Properties("PenColor") = Col
        .Cosmetic = True
    End With
    Xb = Xb + D
    Yb = Y0
 End If
'---------------------------------------------------------------
' Text Fild - Text1=Str1
 If Len(Str12) > 0 Then
    If Im14 <> "" Then
        Set grfChild = grfThis.Graphics.AddText(Str12, Xb - 0.3 * R, Yb + 0.9 * D, Z0, 0.8 * D, 0)
    Else
        Set grfChild = grfThis.Graphics.AddText(Str12, Xb + 0.2 * R, Yb + 0.9 * D, Z0, 0.8 * D, 0)
    End If
     With grfChild
        .Properties("TextFont") = TextF '"gdt.shx"
        .Properties("TextStyle") = 0
        .Properties("PenColor") = Col
        .Cosmetic = True
        Xb = .CalcBoundingBox.Max.X
    End With
    Yb = Y0
 End If
' ---------------------------------------------------------
 If Im15 <> "" Then
    Symb = Mid(Im15, 1, 1)
    Set grfChild = grfThis.Graphics.AddText(Symb, Xb + 0.1 * R, Yb + 0.75 * D, Z0, 0.7 * D)
     With grfChild
        .Properties("TextFont") = ImF15 '"gdt.shx"
        .Properties("TextStyle") = 0
        .Properties("PenColor") = Col
        .Cosmetic = True
    End With
    Xb = Xb + D
    Yb = Y0
 End If
'------------------------------------------------------
        Set grfChild = grfThis.Graphics.Add(11)
        With grfChild.Vertices
            .Add Xb, Y0, Z0
            .Add Xb, Y0 + D, Z0
        End With
                grfChild.Properties("PenColor") = Col
                grfChild.Cosmetic = True
'-------------------------------------------------------------

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

' Text Filds Text2=Str2  Text3=Str3  Text4=Str4
If Len(Str13) > 0 Then
    Set grfChild = grfThis.Graphics.AddText(Str13, Xb + 0.3 * R, Yb + 0.9 * D, Z0, 0.8 * D, 0)
     With grfChild
        .Properties("TextFont") = TextF '"gdt.shx"
        .Properties("TextStyle") = 0
        .Properties("PenColor") = Col
        .Cosmetic = True
        Xb = .CalcBoundingBox.Max.X + 0.3 * R
    End With
    Yb = Y0
    If Im16 <> "" Then
        Xb = Xb - 0.3 * R
        Symb = Mid(Im16, 1, 1)
        Set grfChild = grfThis.Graphics.AddText(Symb, Xb + 0.1 * R, Yb + 0.75 * D, Z0, 0.7 * D)
     With grfChild
        .Properties("TextFont") = ImF16 '"gdt.shx"
        .Properties("TextStyle") = 0
        .Properties("PenColor") = Col
        .Cosmetic = True
    End With
        Xb = Xb + D
        Yb = Y0
    End If
'------------------------------------------------------

    Set grfChild = grfThis.Graphics.Add(11)
        With grfChild.Vertices
            .Add Xb, Y0, Z0
            .Add Xb, Y0 + D, Z0
        End With
                grfChild.Properties("PenColor") = Col
                grfChild.Cosmetic = True
'------------------------------------------------------

End If

If Len(Str14) > 0 Then
    Set grfChild = grfThis.Graphics.AddText(Str14, Xb + 0.3 * R, Yb + 0.9 * D, Z0, 0.8 * D, 0)
     With grfChild
        .Properties("TextFont") = TextF '"gdt.shx"
        .Properties("TextStyle") = 0
        .Properties("PenColor") = Col
        .Cosmetic = True
        Xb = .CalcBoundingBox.Max.X + 0.3 * R
    End With
    Yb = Y0
    If Im17 <> "" Then
        Xb = Xb - 0.3 * R
        Symb = Mid(Im17, 1, 1)
        Set grfChild = grfThis.Graphics.AddText(Symb, Xb + 0.1 * R, Yb + 0.75 * D, Z0, 0.7 * D)
         With grfChild
            .Properties("TextFont") = ImF17 '"gdt.shx"
            .Properties("TextStyle") = 0
            .Properties("PenColor") = Col
            .Cosmetic = True
        End With
        Xb = Xb + D
        Yb = Y0
    End If
' ------------------------------------------------------------------------
        Set grfChild = grfThis.Graphics.Add(11)
        With grfChild.Vertices
            .Add Xb, Y0, Z0
            .Add Xb, Y0 + D, Z0
        End With
                grfChild.Properties("PenColor") = Col
                grfChild.Cosmetic = True
' ------------------------------------------------------------------------
End If

If Len(Str15) > 0 Then
    Set grfChild = grfThis.Graphics.AddText(Str15, Xb + 0.3 * R, Yb + 0.9 * D, Z0, 0.8 * D, 0)
     With grfChild
        .Properties("TextFont") = TextF '"gdt.shx"
        .Properties("TextStyle") = 0
        .Properties("PenColor") = Col
        .Cosmetic = True
        Xb = .CalcBoundingBox.Max.X + 0.3 * R
    End With
    Yb = Y0
    If Im18 <> "" Then
        Xb = Xb - 0.3 * R
        Symb = Mid(Im18, 1, 1)
        Set grfChild = grfThis.Graphics.AddText(Symb, Xb + 0.1 * R, Yb + 0.75 * D, Z0, 0.7 * D)
         With grfChild
            .Properties("TextFont") = ImF18 '"gdt.shx"
            .Properties("TextStyle") = 0
            .Properties("PenColor") = Col
            .Cosmetic = True
        End With
        Xb = Xb + D
        Yb = Y0
    End If
' ------------------------------------------------------------------------
        Set grfChild = grfThis.Graphics.Add(11)
        With grfChild.Vertices
            .Add Xb, Y0, Z0
            .Add Xb, Y0 + D, Z0
        End With
                grfChild.Properties("PenColor") = Col
                grfChild.Cosmetic = True
' ------------------------------------------------------------------------
End If
Dim Len1#
'MsgBox ("2222222x0=" & CStr(X0) & "  y0=" & CStr(Y0) & " z0=" & CStr(Z0))
Dim X10#, Y10#, X11#, Y11#, X12#, Y12#, X13#, Y13#
            With grfThis.Vertices
                .Item(0).X = X0
                .Item(0).Y = Y0
                .Item(0).Z = Z0
                .Item(1).X = Xb
                .Item(1).Y = Y0
                .Item(1).Z = Z0
'                X1 = .Item(1).X
'                Y1 = .Item(1).Y
                Len1 = Xb - X0
                X10 = .Item(0).X
                Y10 = .Item(0).Y
'                Z0 = .Item(0).Z
            End With
Dim dxW#, dyW#
            dxW = X0 - X10
            dyW = Y0 - Y10

'MsgBox ("333333x0=" & CStr(X0) & "  y0=" & CStr(Y0) & " z0=" & CStr(Z0))
'Dim X10#, Y10#, X11#, Y11#, X12#, Y12#, X13#, Y13#
Dim X14#, Y14#, X15#, Y15#, X16#, Y16#, X17#, Y17#
              With grfThis.Vertices
              '--------------------
                    X10 = X0
                    Y10 = Y0
                    X11 = Xb
                    Y11 = Y0
                    X12 = Xb
                    Y12 = Y0 + D
                    X13 = X0
                    Y13 = Y0 + D

              End With

                    ' Draw Box
    If Mid(Im11, 1, 1) = Mid(Im21, 1, 1) And Im11 <> "" Then
        Set grfChild = grfThis.Graphics.Add(11)
        With grfChild.Vertices
            .Add Xb1, Y10, Z0
            .Add X11, Y11, Z0
        End With
                grfChild.Properties("PenColor") = Col
                        grfChild.Cosmetic = True
    Else
        Set grfChild = grfThis.Graphics.Add(11)
        With grfChild.Vertices
            .Add X10, Y10, Z0
            .Add X11, Y11, Z0
        End With
'MsgBox ("Child  x0=" & CStr(grfChild.Vertices.Item(0).X) & " y0=" & CStr(grfChild.Vertices.Item(0).Y))

                grfChild.Properties("PenColor") = Col
                        grfChild.Cosmetic = True
    End If
    Set grfChild = grfThis.Graphics.Add(11)
    With grfChild.Vertices
        .Add X11, Y11, Z0
        .Add X12, Y12, Z0
        .Add X13, Y13, Z0
        .Add X10, Y10, Z0
    End With
                grfChild.Properties("PenColor") = Col
                    grfChild.Cosmetic = True

' Table - 2 Begin Table - 2 Begin Table - 2 Begin Table - 2 Begin
' Table - 2 Begin Table - 2 Begin Table - 2 Begin Table - 2 Begin
' Table - 2 Begin Table - 2 Begin Table - 2 Begin Table - 2 Begin

 If Im21 <> "" Or Im22 <> "" Or Im23 <> "" Or Im24 <> "" Or Im25 <> "" Or Im26 <> "" Or Im27 <> "" Or Im28 <> "" Or Str21 <> "" Or Str22 <> "" Or Str23 <> "" Or Str24 <> "" Or Str25 <> "" Then
    Y0 = Y0 - D
    If Mid(Im11, 1, 1) = Mid(Im21, 1, 1) And Im11 <> "" Then
'        Xb = Xb1
        GoTo L12
    End If
    If Im21 <> "" Then
        Symb = Mid(Im21, 1, 1)
        If Mid(Im21, 1, 1) = Chr(116) Then
            Set grfChild = grfThis.Graphics.AddText(Symb, X0 + 0.08 * R, Y0 + 0.75 * D, Z0, 0.55 * D)
        Else
            Set grfChild = grfThis.Graphics.AddText(Symb, X0 + 0.1 * R, Y0 + 0.75 * D, Z0, 0.7 * D)
        End If
         With grfChild
            .Properties("TextFont") = ImF21 '"gdt.shx"
            .Properties("TextStyle") = 0
            .Properties("PenColor") = Col
            .Cosmetic = True
        End With
    End If
    If Im21 = "" Then
        Xb = X0
        Yb = Y0
        GoTo L11
    End If
L12:
'------------------------------------------------------
     Set grfChild = grfThis.Graphics.Add(11)
    With grfChild.Vertices
        .Add X0 + D, Y0, Z0
        .Add X0 + D, Y0 + D, Z0
    End With
                grfChild.Properties("PenColor") = Col
                grfChild.Cosmetic = True
'--------------------------------------------------------------

    Xb = X0 + D
    Yb = Y0
L11:
    If Mid(Im22, 1, 1) = Chr(110) Then
        Symb = Mid(Im22, 1, 1)
        Set grfChild = grfThis.Graphics.AddText(Symb, Xb + 0.15 * D, Yb + 0.75 * D, Z0, 0.75 * D)
         With grfChild
            .Properties("TextFont") = ImF22 '"gdt.shx"
            .Properties("TextStyle") = 0
            .Properties("PenColor") = Col
            .Cosmetic = True
        End With
        Xb = Xb + D
        Yb = Y0
    End If
'---------------------------------------------------------------
' Text Fild - Text1=Str1
    If Len(Str21) > 0 Then
        If Im22 <> "" Then
            Set grfChild = grfThis.Graphics.AddText(Str21, Xb - 0.3 * R, Yb + 0.9 * D, Z0, 0.8 * D, 0)
        Else
            Set grfChild = grfThis.Graphics.AddText(Str21, Xb + 0.2 * R, Yb + 0.9 * D, Z0, 0.8 * D, 0)
        End If
         With grfChild
            .Properties("TextFont") = TextF '"gdt.shx"
            .Properties("TextStyle") = 0
            .Properties("PenColor") = Col
            .Cosmetic = True
            Xb = .CalcBoundingBox.Max.X
        End With
        Yb = Y0
    End If
' ---------------------------------------------------------
    If Im23 <> "" Then
        Symb = Mid(Im23, 1, 1)
        Set grfChild = grfThis.Graphics.AddText(Symb, Xb + 0.1 * R, Yb + 0.75 * D, Z0, 0.7 * D)
         With grfChild
            .Properties("TextFont") = ImF23 '"gdt.shx"
            .Properties("TextStyle") = 0
            .Properties("PenColor") = Col
            .Cosmetic = True
        End With
        Xb = Xb + D
        Yb = Y0
    End If
'------------------------------------------------------
        Set grfChild = grfThis.Graphics.Add(11)
        With grfChild.Vertices
            .Add Xb, Y0, Z0
            .Add Xb, Y0 + D, Z0
        End With
                grfChild.Properties("PenColor") = Col
                grfChild.Cosmetic = True
'--------------------------------------------------------------

' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Table-1  Datum-2
    If Mid(Im24, 1, 1) = Chr(110) Then
        Symb = Mid(Im24, 1, 1)
        Set grfChild = grfThis.Graphics.AddText(Symb, Xb + 0.15 * D, Yb + 0.75 * D, Z0, 0.75 * D)
         With grfChild
            .Properties("TextFont") = ImF24 '"gdt.shx"
            .Properties("TextStyle") = 0
            .Properties("PenColor") = Col
            .Cosmetic = True
        End With
        Xb = Xb + D
        Yb = Y0
    End If
'---------------------------------------------------------------
' Text Fild - Text1=Str1
    If Len(Str22) > 0 Then
        If Im24 <> "" Then
            Set grfChild = grfThis.Graphics.AddText(Str22, Xb - 0.3 * R, Yb + 0.9 * D, Z0, 0.8 * D, 0)
        Else
            Set grfChild = grfThis.Graphics.AddText(Str22, Xb + 0.2 * R, Yb + 0.9 * D, Z0, 0.8 * D, 0)
        End If
         With grfChild
            .Properties("TextFont") = TextF '"gdt.shx"
            .Properties("TextStyle") = 0
            .Properties("PenColor") = Col
            .Cosmetic = True
            Xb = .CalcBoundingBox.Max.X
       End With
        Yb = Y0
    End If
' ---------------------------------------------------------
    If Im25 <> "" Then
        Symb = Mid(Im25, 1, 1)
        Set grfChild = grfThis.Graphics.AddText(Symb, Xb + 0.1 * R, Yb + 0.75 * D, Z0, 0.7 * D)
         With grfChild
            .Properties("TextFont") = ImF25 '"gdt.shx"
            .Properties("TextStyle") = 0
            .Properties("PenColor") = Col
            .Cosmetic = True
        End With
        Xb = Xb + D
        Yb = Y0
    End If
'------------------------------------------------------
        Set grfChild = grfThis.Graphics.Add(11)
        With grfChild.Vertices
            .Add Xb, Y0, Z0
            .Add Xb, Y0 + D, Z0
        End With
                grfChild.Properties("PenColor") = Col
                grfChild.Cosmetic = True
'-------------------------------------------------------------

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

' Text Filds Text2=Str2  Text3=Str3  Text4=Str4
    If Len(Str23) > 0 Then
        Set grfChild = grfThis.Graphics.AddText(Str23, Xb + 0.3 * R, Yb + 0.9 * D, Z0, 0.8 * D)
         With grfChild
            .Properties("TextFont") = TextF '"gdt.shx"
            .Properties("TextStyle") = 0
            .Properties("PenColor") = Col
            .Cosmetic = True
            Xb = .CalcBoundingBox.Max.X + 0.3 * R
        End With
        Yb = Y0
        If Im26 <> "" Then
            Xb = Xb - 0.3 * R
            Symb = Mid(Im26, 1, 1)
           Set grfChild = grfThis.Graphics.AddText(Symb, Xb + 0.1 * R, Yb + 0.75 * D, Z0, 0.7 * D)
             With grfChild
                .Properties("TextFont") = ImF26 '"gdt.shx"
                .Properties("TextStyle") = 0
                .Properties("PenColor") = Col
                .Cosmetic = True
            End With
            Xb = Xb + D
            Yb = Y0
        End If
' --------------------------------------------------------------
        Set grfChild = grfThis.Graphics.Add(11)
        With grfChild.Vertices
            .Add Xb, Y0, Z0
            .Add Xb, Y0 + D, Z0
        End With
                grfChild.Properties("PenColor") = Col
                   grfChild.Cosmetic = True
' --------------------------------------------------------------------------
    End If

    If Len(Str24) > 0 Then
        Set grfChild = grfThis.Graphics.AddText(Str24, Xb + 0.3 * R, Yb + 0.9 * D, Z0, 0.8 * D, 0)
         With grfChild
            .Properties("TextFont") = TextF
            .Properties("TextStyle") = 0
            .Properties("PenColor") = Col
            .Cosmetic = True
            Xb = .CalcBoundingBox.Max.X + 0.3 * R
        End With
        Yb = Y0
        If Im27 <> "" Then
            Xb = Xb - 0.3 * R
            Symb = Mid(Im27, 1, 1)
            Set grfChild = grfThis.Graphics.AddText(Symb, Xb + 0.1 * R, Yb + 0.75 * D, Z0, 0.7 * D)
             With grfChild
                .Properties("TextFont") = ImF27 '"gdt.shx"
                .Properties("TextStyle") = 0
                .Properties("PenColor") = Col
                .Cosmetic = True
            End With
            Xb = Xb + D
            Yb = Y0
        End If
'---------------------------------------------------------------
        Set grfChild = grfThis.Graphics.Add(11)
        With grfChild.Vertices
            .Add Xb, Y0, 0
            .Add Xb, Y0 + D, 0
        End With
                grfChild.Properties("PenColor") = Col
                    grfChild.Cosmetic = True
'---------------------------------------------------------------
    End If

    If Len(Str25) > 0 Then
        Set grfChild = grfThis.Graphics.AddText(Str25, Xb + 0.3 * R, Yb + 0.9 * D, Z0, 0.8 * D, 0)
         With grfChild
            .Properties("TextFont") = TextF
            .Properties("TextStyle") = 0
            .Properties("PenColor") = Col
            .Cosmetic = True
            Xb = .CalcBoundingBox.Max.X + 0.3 * R
        End With
        Yb = Y0
        If Im28 <> "" Then
            Xb = Xb - 0.3 * R
            Symb = Mid(Im28, 1, 1)
            Set grfChild = grfThis.Graphics.AddText(Symb, Xb + 0.1 * R, Yb + 0.75 * D, Z0, 0.7 * D)
             With grfChild
                .Properties("TextFont") = ImF28 '"gdt.shx"
                .Properties("TextStyle") = 0
                .Properties("PenColor") = Col
                .Cosmetic = True
            End With
            Xb = Xb + D
            Yb = Y0
        End If

        Set grfChild = grfThis.Graphics.Add(11)
        With grfChild.Vertices
            .Add Xb, Y0, Z0
            .Add Xb, Y0 + D, Z0
        End With
                grfChild.Properties("PenColor") = Col
                    grfChild.Cosmetic = True
    End If

                            ' Draw Box

    Set grfChild = grfThis.Graphics.Add(11)
    With grfChild.Vertices
        .Add X0, Y0 + D, Z0
        .Add X0, Y0, Z0
        .Add Xb, Y0, Z0
    End With
                grfChild.Properties("PenColor") = Col
                grfChild.Cosmetic = True

    If Mid(Im11, 1, 1) = Mid(Im21, 1, 1) And Im11 <> "" Then
        Set grfChild = grfThis.Graphics.Add(11)
        With grfChild.Vertices
            .Add Xb1, Y0 + D, Z0
            .Add Xb, Y0 + D, Z0
        End With
                grfChild.Properties("PenColor") = Col
                    grfChild.Cosmetic = True
    Else
        Set grfChild = grfThis.Graphics.Add(11)
        With grfChild.Vertices
            .Add X0, Y0 + D, Z0
            .Add Xb, Y0 + D, Z0
        End With
                grfChild.Properties("PenColor") = Col
                    grfChild.Cosmetic = True
    End If
 End If

' Table - 2 End  Table - 2 End  Table - 2 End  Table - 2 End  Table - 2 End
' Table - 2 End  Table - 2 End  Table - 2 End  Table - 2 End  Table - 2 End
' Table - 2 End  Table - 2 End  Table - 2 End  Table - 2 End  Table - 2 End

' Table - 3 Begin Table - 3 Begin Table - 3 Begin Table - 3 Begin
' Table - 3 Begin Table - 3 Begin Table - 3 Begin Table - 3 Begin
' Table - 3 Begin Table - 3 Begin Table - 3 Begin Table - 3 Begin

 If Len(Str31) > 0 Then
    Y0 = Y0 - D

    Set grfChild = grfThis.Graphics.AddText(Str31, X0 + 0.3 * R, Y0 + 0.9 * D, Z0, 0.8 * D)
    With grfChild
        .Properties("TextFont") = TextF
        .Properties("TextStyle") = 0
        .Properties("PenColor") = Col
        .Cosmetic = True
        Xb = .CalcBoundingBox.Max.X + 0.3 * R
    End With
    Yb = Y0
    Xb = Xb - 0.5 * R
    If Mid(Im31, 1, 1) = Chr(112) Then
        Symb = Mid(Im31, 1, 1)
        Set grfChild = grfThis.Graphics.AddText(Symb, Xb + 0.2 * R, Yb + 0.75 * D, Z0, 0.7 * D)
         With grfChild
            .Properties("TextFont") = ImF31 '"gdt.shx"
            .Properties("TextStyle") = 0
            .Properties("PenColor") = Col
            .Cosmetic = True
        End With
        Xb = Xb + D
        Yb = Y0
    End If
    If Im31 = "" Then
        Xb = Xb + 0.5 * R
    End If
                                ' Draw Box

    Set grfChild = grfThis.Graphics.Add(11)
    With grfChild.Vertices
        .Add X0, Y0, Z0
        .Add Xb, Y0, Z0
        .Add Xb, Y0 + D, Z0
        .Add X0, Y0 + D, Z0
        .Add X0, Y0, Z0
    End With
                grfChild.Properties("PenColor") = Col
                grfChild.Cosmetic = True
 End If

' Table - 3 End  Table - 3 End  Table - 3 End  Table - 3 End  Table - 3 End
' Table - 3 End  Table - 3 End  Table - 3 End  Table - 3 End  Table - 3 End

' Table - 4 Begin Table - 4 Begin Table - 4 Begin Table - 4 Begin
' Table - 4 Begin Table - 4 Begin Table - 4 Begin Table - 4 Begin

 If Len(Str41) > 0 Then
    Y0 = Y0 - D

    Set grfChild = grfThis.Graphics.AddText(Str41, X0 + 0.3 * R, Y0 + 0.9 * D, Z0, 0.8 * D, 0, , , 1)
    With grfChild
        .Properties("TextFont") = TextF
        .Properties("TextStyle") = 0
        .Properties("PenColor") = Col
        .Cosmetic = True
        Xb = .CalcBoundingBox.Max.X + 0.2 * R
    End With

                             ' Draw Box

    Set grfChild = grfThis.Graphics.Add(11)
    With grfChild.Vertices
        .Add X0, Y0, Z0
        .Add Xb, Y0, Z0
        .Add Xb, Y0 + D, Z0
        .Add X0, Y0 + D, Z0
        .Add X0, Y0, Z0
    End With
                grfChild.Properties("PenColor") = Col
                grfChild.Cosmetic = True

 End If

' Table - 4 End  Table - 4 End  Table - 4 End  Table - 4 End  Table - 4 End
' Table - 4 End  Table - 4 End  Table - 4 End  Table - 4 End  Table - 4 End
        X0 = grfThis.Vertices.Item(0).X
        Y0 = grfThis.Vertices.Item(0).Y
        X1 = grfThis.Vertices.Item(1).X
        Y1 = grfThis.Vertices.Item(1).Y
 Dim Z1#

Dim CountCosm As Long, iCosm As Long, nV As Long, iV As Long, xi#, yi#, xir#, yir#
                xi = X1 - X0
                yi = Y1 - Y0
                xir = X0 + xi * Calp - yi * Salp
                yir = Y0 + xi * Salp + yi * Calp
                grfThis.Vertices.Item(1).X = xir
                grfThis.Vertices.Item(1).Y = yir

'MsgBox ("x00=" & CStr(X00) & "  y00=" & CStr(Y00)) ' & " z0=" & CStr((Z0 + z1) / 2))
        CountCosm = grfThis.Graphics.Count
        For iCosm = 0 To CountCosm - 1
            Set grfChild = grfThis.Graphics.Item(iCosm)
            If iCosm <> 0 Then
                On Error Resume Next
                grfChild.Properties("PenStyle") = "CONTINUOUS"
                grfChild.Update
                grfChild.Properties("Thickness") = 0
            End If
            With grfChild.Vertices
                 nV = .Count
                 For iV = 0 To nV - 1
                     xi = .Item(iV).X - X0
                     yi = .Item(iV).Y - Y0
                     xir = X0 + xi * Calp - yi * Salp
                     yir = Y0 + xi * Salp + yi * Calp
                     .Item(iV).X = xir
                     .Item(iV).Y = yir
                Next iV
            End With
        Next iCosm
            'Add visible child Graphics
        End If

        grfThis.RegenUnlock

        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:
        'grfThis.Application.PopVertexDefaults
If Err.Description = "Division by zero" Then GoTo LLL
        If Err.Number <> 0 Then
            'MsgBox "Regen error: " & Err.Description
        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function

Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = pi / 2
            Else
                Angle = 3 * pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * pi + Atn(sinb / cosb)
        End If
End Function


Examples - Tolerance Symbol Regen - DatRef.frm

DatRef.frm

Tolerance Symbol Regen Example

VERSION 5.00
Begin VB.Form frmDatRef
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Tolerance"
   ClientHeight    =   4770
   ClientLeft      =   3420
   ClientTop       =   2895
   ClientWidth     =   9360
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4770
   ScaleWidth      =   9360
   Begin VB.PictureBox Image14
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   3000
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   57
      Top             =   960
      Width           =   375
   End
   Begin VB.PictureBox Image25
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   4440
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   56
      Top             =   1560
      Width           =   375
   End
   Begin VB.PictureBox Image15
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   4440
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   55
      Top             =   960
      Width           =   375
   End
   Begin VB.PictureBox Image31
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   2400
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   24
      Top             =   2160
      Width           =   375
   End
   Begin VB.PictureBox Image28
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   8760
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   22
      Top             =   1560
      Width           =   375
   End
   Begin VB.PictureBox Image27
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   7320
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   20
      Top             =   1560
      Width           =   375
   End
   Begin VB.PictureBox Image26
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   5880
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   18
      Top             =   1560
      Width           =   375
   End
   Begin VB.PictureBox Image24
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   3000
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   15
      Top             =   1560
      Width           =   375
   End
   Begin VB.PictureBox Image23
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   2400
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   14
      Top             =   1560
      Width           =   375
   End
   Begin VB.PictureBox Image22
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   960
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   12
      Top             =   1560
      Width           =   375
   End
   Begin VB.PictureBox Image21
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   360
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   11
      Top             =   1560
      Width           =   375
   End
   Begin VB.PictureBox Image18
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   8760
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   10
      Top             =   960
      Width           =   375
   End
   Begin VB.PictureBox Image17
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   7320
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   8
      Top             =   960
      Width           =   375
   End
   Begin VB.PictureBox Image16
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   5880
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   6
      Top             =   960
      Width           =   375
   End
   Begin VB.PictureBox Image13
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   2400
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   3
      Top             =   960
      Width           =   375
   End
   Begin VB.PictureBox Image12
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   960
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   1
      Top             =   960
      Width           =   375
   End
   Begin VB.PictureBox Image11
      AutoSize        =   -1  'True
      Height          =   375
      Left            =   360
      ScaleHeight     =   315
      ScaleWidth      =   315
      TabIndex        =   0
      Top             =   960
      Width           =   375
   End
   Begin VB.Frame Frame2
      Caption         =   "Font Height"
      Height          =   735
      Left            =   360
      TabIndex        =   53
      Top             =   3840
      Width           =   1575
      Begin VB.TextBox ScaleSym
         Height          =   315
         Left            =   240
         TabIndex        =   26
         Text            =   "1"
         Top             =   240
         Width           =   1095
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "Font Setting"
      Height          =   735
      Left            =   2040
      TabIndex        =   52
      Top             =   3840
      Width           =   3615
      Begin VB.CommandButton Font1
         Caption         =   "Font"
         Enabled         =   0   'False
         Height          =   375
         Left            =   2265
         TabIndex        =   28
         Top             =   240
         Width           =   1215
      End
      Begin VB.CheckBox CheckFont
         Caption         =   "Use the document font"
         Height          =   375
         Left            =   240
         TabIndex        =   27
         Top             =   240
         Value           =   1  'Checked
         Width           =   1935
      End
   End
   Begin VB.CommandButton Help1
      Caption         =   "Help"
      Height          =   375
      Left            =   7680
      TabIndex        =   31
      Top             =   3600
      Width           =   1215
   End
   Begin VB.TextBox Text41
      Height          =   375
      Left            =   360
      ScrollBars      =   1  'Horizontal
      TabIndex        =   25
      Top             =   2760
      Width           =   4455
   End
   Begin VB.TextBox Text31
      Height          =   375
      Left            =   360
      TabIndex        =   23
      Top             =   2160
      Width           =   1935
   End
   Begin VB.TextBox Text25
      Height          =   375
      Left            =   7920
      TabIndex        =   21
      Top             =   1560
      Width           =   735
   End
   Begin VB.TextBox Text22
      Height          =   375
      Left            =   3480
      TabIndex        =   16
      Top             =   1560
      Width           =   855
   End
   Begin VB.TextBox Text12
      Height          =   375
      Left            =   3480
      TabIndex        =   4
      Top             =   960
      Width           =   855
   End
   Begin VB.TextBox Text24
      Height          =   375
      Left            =   6480
      TabIndex        =   19
      Top             =   1560
      Width           =   735
   End
   Begin VB.TextBox Text23
      Height          =   375
      Left            =   5040
      TabIndex        =   17
      Top             =   1560
      Width           =   735
   End
   Begin VB.TextBox Text21
      Height          =   375
      Left            =   1440
      TabIndex        =   13
      Top             =   1560
      Width           =   855
   End
   Begin VB.TextBox Text15
      Height          =   375
      Left            =   7920
      TabIndex        =   9
      Top             =   960
      Width           =   735
   End
   Begin VB.TextBox Text14
      Height          =   375
      Left            =   6480
      TabIndex        =   7
      Top             =   960
      Width           =   735
   End
   Begin VB.TextBox Text13
      Height          =   375
      Left            =   5040
      TabIndex        =   5
      Top             =   960
      Width           =   735
   End
   Begin VB.TextBox Text11
      Height          =   375
      Left            =   1440
      TabIndex        =   2
      Text            =   "0.00"
      Top             =   960
      Width           =   855
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   7680
      TabIndex        =   29
      Top             =   2400
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   7680
      TabIndex        =   30
      Top             =   3000
      Width           =   1215
   End
   Begin VB.Line Line26
      BorderWidth     =   2
      X1              =   3840
      X2              =   5760
      Y1              =   3600
      Y2              =   3600
   End
   Begin VB.Line Line18
      BorderWidth     =   2
      X1              =   5760
      X2              =   5760
      Y1              =   3600
      Y2              =   4680
   End
   Begin VB.Line Line17
      BorderWidth     =   2
      X1              =   5760
      X2              =   240
      Y1              =   4680
      Y2              =   4680
   End
   Begin VB.Line Line16
      BorderWidth     =   2
      X1              =   240
      X2              =   240
      Y1              =   4680
      Y2              =   3600
   End
   Begin VB.Line Line15
      BorderWidth     =   2
      X1              =   2160
      X2              =   240
      Y1              =   3600
      Y2              =   3600
   End
   Begin VB.Label Label1
      Caption         =   "Frame Parameters"
      Height          =   252
      Left            =   2280
      TabIndex        =   54
      Top             =   3480
      Width           =   1452
   End
   Begin VB.Line Line25
      BorderStyle     =   3  'Dot
      X1              =   9240
      X2              =   9240
      Y1              =   840
      Y2              =   240
   End
   Begin VB.Line Line24
      BorderStyle     =   3  'Dot
      X1              =   7800
      X2              =   7800
      Y1              =   840
      Y2              =   240
   End
   Begin VB.Line Line23
      BorderStyle     =   3  'Dot
      X1              =   6360
      X2              =   6360
      Y1              =   840
      Y2              =   240
   End
   Begin VB.Line Line22
      BorderStyle     =   3  'Dot
      X1              =   4920
      X2              =   4920
      Y1              =   840
      Y2              =   240
   End
   Begin VB.Line Line21
      BorderStyle     =   3  'Dot
      X1              =   2880
      X2              =   2880
      Y1              =   840
      Y2              =   240
   End
   Begin VB.Line Line20
      BorderStyle     =   3  'Dot
      X1              =   840
      X2              =   840
      Y1              =   840
      Y2              =   240
   End
   Begin VB.Line Line19
      BorderStyle     =   3  'Dot
      X1              =   240
      X2              =   240
      Y1              =   840
      Y2              =   240
   End
   Begin VB.Label Label3
      Caption         =   "Sym"
      Height          =   255
      Left            =   360
      TabIndex        =   51
      Top             =   120
      Width           =   375
   End
   Begin VB.Label Label2
      Caption         =   "Tolerance1"
      Height          =   255
      Left            =   1440
      TabIndex        =   50
      Top             =   120
      Width           =   855
   End
   Begin VB.Label Label21
      Caption         =   "MC"
      Height          =   255
      Left            =   8880
      TabIndex        =   49
      Top             =   480
      Width           =   255
   End
   Begin VB.Label Label20
      Caption         =   "Datum"
      Height          =   255
      Left            =   8040
      TabIndex        =   48
      Top             =   480
      Width           =   495
   End
   Begin VB.Label Label19
      Caption         =   "MC"
      Height          =   255
      Left            =   7440
      TabIndex        =   47
      Top             =   480
      Width           =   255
   End
   Begin VB.Label Label18
      Caption         =   "Datum"
      Height          =   255
      Left            =   6600
      TabIndex        =   46
      Top             =   480
      Width           =   495
   End
   Begin VB.Label Label17
      Caption         =   "MC"
      Height          =   255
      Left            =   6000
      TabIndex        =   45
      Top             =   480
      Width           =   255
   End
   Begin VB.Label Label16
      Caption         =   "Datum"
      Height          =   255
      Left            =   5160
      TabIndex        =   44
      Top             =   480
      Width           =   495
   End
   Begin VB.Label Label15
      Caption         =   "MC"
      Height          =   255
      Left            =   4560
      TabIndex        =   43
      Top             =   480
      Width           =   255
   End
   Begin VB.Label Label14
      Caption         =   "Value"
      Height          =   255
      Left            =   3720
      TabIndex        =   42
      Top             =   480
      Width           =   495
   End
   Begin VB.Label Label13
      Caption         =   "Dia"
      Height          =   255
      Left            =   3000
      TabIndex        =   41
      Top             =   480
      Width           =   375
   End
   Begin VB.Label Label12
      Caption         =   "MC"
      Height          =   255
      Left            =   2520
      TabIndex        =   40
      Top             =   480
      Width           =   255
   End
   Begin VB.Label Label11
      Caption         =   "Value"
      Height          =   255
      Left            =   1560
      TabIndex        =   39
      Top             =   480
      Width           =   495
   End
   Begin VB.Label Label10
      Caption         =   "Dia"
      Height          =   255
      Left            =   960
      TabIndex        =   38
      Top             =   480
      Width           =   375
   End
   Begin VB.Label Label9
      Caption         =   "Datum Identifier"
      Height          =   375
      Left            =   5160
      TabIndex        =   37
      Top             =   2760
      Width           =   1215
   End
   Begin VB.Label Label8
      Caption         =   "   Height projected tolerance zone"
      Height          =   255
      Left            =   3120
      TabIndex        =   36
      Top             =   2280
      Width           =   2535
   End
   Begin VB.Label Label7
      Caption         =   "Datum3"
      Height          =   255
      Left            =   8160
      TabIndex        =   35
      Top             =   120
      Width           =   615
   End
   Begin VB.Label Label6
      Caption         =   "Datum2"
      Height          =   255
      Left            =   6720
      TabIndex        =   34
      Top             =   120
      Width           =   615
   End
   Begin VB.Label Label5
      Caption         =   "Datum1"
      Height          =   255
      Left            =   5280
      TabIndex        =   33
      Top             =   120
      Width           =   615
   End
   Begin VB.Label Label4
      Caption         =   "Tolerance2"
      Height          =   255
      Left            =   3480
      TabIndex        =   32
      Top             =   120
      Width           =   975
   End
   Begin VB.Line Line14
      BorderWidth     =   3
      X1              =   4920
      X2              =   4920
      Y1              =   2640
      Y2              =   3240
   End
   Begin VB.Line Line13
      BorderWidth     =   3
      X1              =   2880
      X2              =   2880
      Y1              =   2040
      Y2              =   2640
   End
   Begin VB.Line Line12
      BorderWidth     =   3
      X1              =   240
      X2              =   4920
      Y1              =   2640
      Y2              =   2640
   End
   Begin VB.Line Line11
      BorderWidth     =   3
      X1              =   240
      X2              =   4920
      Y1              =   3240
      Y2              =   3240
   End
   Begin VB.Line Line10
      BorderWidth     =   3
      X1              =   9240
      X2              =   9240
      Y1              =   840
      Y2              =   2040
   End
   Begin VB.Line Line9
      BorderWidth     =   3
      X1              =   7800
      X2              =   7800
      Y1              =   840
      Y2              =   2040
   End
   Begin VB.Line Line8
      BorderWidth     =   3
      X1              =   6360
      X2              =   6360
      Y1              =   840
      Y2              =   2040
   End
   Begin VB.Line Line7
      BorderWidth     =   3
      X1              =   4920
      X2              =   4920
      Y1              =   840
      Y2              =   2040
   End
   Begin VB.Line Line6
      BorderWidth     =   3
      X1              =   2880
      X2              =   2880
      Y1              =   840
      Y2              =   2040
   End
   Begin VB.Line Line5
      BorderWidth     =   3
      X1              =   840
      X2              =   840
      Y1              =   840
      Y2              =   2040
   End
   Begin VB.Line Line4
      BorderWidth     =   3
      X1              =   240
      X2              =   240
      Y1              =   840
      Y2              =   3240
   End
   Begin VB.Line Line2
      BorderWidth     =   3
      X1              =   240
      X2              =   9240
      Y1              =   2040
      Y2              =   2040
   End
   Begin VB.Line Line1
      BorderWidth     =   3
      X1              =   240
      X2              =   9240
      Y1              =   1440
      Y2              =   1440
   End
   Begin VB.Line Line3
      BorderWidth     =   3
      X1              =   240
      X2              =   9240
      Y1              =   840
      Y2              =   840
   End
End
Attribute VB_Name = "frmDatRef"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean
Private Im110$, Im120$, Im130$, Im140$, Im150$, Im160$, Im170$, Im180$
Private Str110$, Str120$, Str130$, Str140$, Str150$
Private Im210$, Im220$, Im230$, Im240$, Im250$, Im260$, Im270$, Im280$
Private Str210$, Str220$, Str230$, Str240$, Str250$
Private Im310$
Private Str310$
Private Str410$
Private SymTxtHeight0#
Private TextF0$

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub CheckFont_Click()
    If CheckFont.Value = 0 Then Font1.Enabled = True    ' !!!!!!!!!!!!
    If CheckFont.Value = 1 Then Font1.Enabled = False   ' !!!!!!!!!!!!
End Sub

Private Sub CheckFont_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub cmdCancel_Click()
    Call EscClick
End Sub

Private Sub cmdOK_Click()
On Error GoTo Failed
    SymTxtHeight = CDbl(frmDatRef.ScaleSym.Text)
    If SymTxtHeight <= 0 Then GoTo Failed
    Unload frmTolSymbol
    Unload frmTolMC
    Unload frmChooseFont

    blnDialogCanceled = False

    Me.Hide

    Exit Sub
Failed:
 MsgBox ("Please enter a valid Textheight")
End Sub

Private Sub Picture1_Click()

End Sub

Private Sub Font1_Click()
    frmChooseFont.Show 1
End Sub

Private Sub Font1_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub Form_Load()
    Im110 = Im11
    Im120 = Im12
    Im130 = Im13
    Im140 = Im14
    Im150 = Im15
    Im160 = Im16
    Im170 = Im17
    Im180 = Im18
    Str110 = Str11
    Str120 = Str12
    Str130 = Str13
    Str140 = Str14
    Str150 = Str15

    Im210 = Im21
    Im220 = Im22
    Im230 = Im23
    Im240 = Im24
    Im250 = Im25
    Im260 = Im26
    Im270 = Im27
    Im280 = Im28
    Str210 = Str21
    Str220 = Str22
    Str230 = Str23
    Str240 = Str24
    Str250 = Str25

    Im310 = Im31
    Str310 = Str31

    Str410 = Str41

    SymTxtHeight0 = SymTxtHeight

    TextF0 = TextF

    If TextF = "Times New Roman" Then
        CheckFont.Value = 1     '!!!!!!!!!
        Font1.Enabled = False   '!!!!!!!!!
    Else
        CheckFont.Value = 0     '!!!!!!!!!
        Font1.Enabled = True   '!!!!!!!!!
    End If
' Begin Tabl.1
If Im11 = "" Then
    frmDatRef.Image11.Picture = frmTolSymbol.Image1.Picture
End If
If Mid(Im11, 1, 1) = Chr(106) Then
    frmDatRef.Image11.Picture = frmTolSymbol.Image2.Picture
End If
If Mid(Im11, 1, 1) = Chr(98) Then
    frmDatRef.Image11.Picture = frmTolSymbol.Image3.Picture
End If
If Mid(Im11, 1, 1) = Chr(102) Then
    frmDatRef.Image11.Picture = frmTolSymbol.Image4.Picture
End If
If Mid(Im11, 1, 1) = Chr(104) Then
    frmDatRef.Image11.Picture = frmTolSymbol.Image5.Picture
End If
If Mid(Im11, 1, 1) = Chr(114) Then
    frmDatRef.Image11.Picture = frmTolSymbol.Image6.Picture
End If
If Mid(Im11, 1, 1) = Chr(105) Then
    frmDatRef.Image11.Picture = frmTolSymbol.Image7.Picture
End If
If Mid(Im11, 1, 1) = Chr(97) Then
    frmDatRef.Image11.Picture = frmTolSymbol.Image8.Picture
End If
If Mid(Im11, 1, 1) = Chr(103) Then
    frmDatRef.Image11.Picture = frmTolSymbol.Image9.Picture
End If
If Mid(Im11, 1, 1) = Chr(99) Then
    frmDatRef.Image11.Picture = frmTolSymbol.Image10.Picture
End If
If Mid(Im11, 1, 1) = Chr(101) Then
    frmDatRef.Image11.Picture = frmTolSymbol.Image11.Picture
End If
If Mid(Im11, 1, 1) = Chr(117) Then
    frmDatRef.Image11.Picture = frmTolSymbol.Image12.Picture
End If
If Mid(Im11, 1, 1) = Chr(100) Then
    frmDatRef.Image11.Picture = frmTolSymbol.Image13.Picture
End If
If Mid(Im11, 1, 1) = Chr(107) Then
    frmDatRef.Image11.Picture = frmTolSymbol.Image14.Picture
End If
If Mid(Im11, 1, 1) = Chr(116) Then
    frmDatRef.Image11.Picture = frmTolSymbol.Image15.Picture
End If

'-------------------------------------------------------
If Im12 = "" Then
    frmDatRef.Image12.Picture = frmTolSymbol.Image1.Picture
End If
If Mid(Im12, 1, 1) = Chr(110) Then
    frmDatRef.Image12.Picture = frmTolSymbol.Image16.Picture
End If
'-------------------------------------------------------
If Im13 = "" Then
    frmDatRef.Image13.Picture = frmTolMC.Image1.Picture
End If
If Mid(Im13, 1, 1) = Chr(109) Then
    frmDatRef.Image13.Picture = frmTolMC.Image17.Picture
End If
If Mid(Im13, 1, 1) = Chr(108) Then
    frmDatRef.Image13.Picture = frmTolMC.Image18.Picture
End If
If Mid(Im13, 1, 1) = Chr(115) Then
    frmDatRef.Image13.Picture = frmTolMC.Image19.Picture
End If
'-------------------------------------------------------
If Im14 = "" Then
    frmDatRef.Image14.Picture = frmTolSymbol.Image1.Picture
End If
If Mid(Im14, 1, 1) = Chr(110) Then
    frmDatRef.Image14.Picture = frmTolSymbol.Image16.Picture
End If
'--------------------------------------------------------
If Im15 = "" Then
    frmDatRef.Image15.Picture = frmTolMC.Image1.Picture
End If
If Mid(Im15, 1, 1) = Chr(109) Then
    frmDatRef.Image15.Picture = frmTolMC.Image17.Picture
End If
If Mid(Im15, 1, 1) = Chr(108) Then
    frmDatRef.Image15.Picture = frmTolMC.Image18.Picture
End If
If Mid(Im15, 1, 1) = Chr(115) Then
    frmDatRef.Image15.Picture = frmTolMC.Image19.Picture
End If
'-------------------------------------------------------
If Im16 = "" Then
    frmDatRef.Image16.Picture = frmTolMC.Image1.Picture
End If
If Mid(Im16, 1, 1) = Chr(109) Then
    frmDatRef.Image16.Picture = frmTolMC.Image17.Picture
End If
If Mid(Im16, 1, 1) = Chr(108) Then
    frmDatRef.Image16.Picture = frmTolMC.Image18.Picture
End If
If Mid(Im16, 1, 1) = Chr(115) Then
    frmDatRef.Image16.Picture = frmTolMC.Image19.Picture
End If
'-------------------------------------------------------
If Im17 = "" Then
    frmDatRef.Image17.Picture = frmTolMC.Image1.Picture
End If
If Mid(Im17, 1, 1) = Chr(109) Then
    frmDatRef.Image17.Picture = frmTolMC.Image17.Picture
End If
If Mid(Im17, 1, 1) = Chr(108) Then
    frmDatRef.Image17.Picture = frmTolMC.Image18.Picture
End If
If Mid(Im17, 1, 1) = Chr(115) Then
    frmDatRef.Image17.Picture = frmTolMC.Image19.Picture
End If
'-------------------------------------------------------
If Im18 = "" Then
    frmDatRef.Image18.Picture = frmTolMC.Image1.Picture
End If
If Mid(Im18, 1, 1) = Chr(109) Then
    frmDatRef.Image18.Picture = frmTolMC.Image17.Picture
End If
If Mid(Im18, 1, 1) = Chr(108) Then
    frmDatRef.Image18.Picture = frmTolMC.Image18.Picture
End If
If Mid(Im18, 1, 1) = Chr(115) Then
    frmDatRef.Image18.Picture = frmTolMC.Image19.Picture
End If

frmDatRef.Text11.Text = Str11
frmDatRef.Text12.Text = Str12
frmDatRef.Text13.Text = Str13
frmDatRef.Text14.Text = Str14
frmDatRef.Text15.Text = Str15

'-------------------------------------------------------
' End Tabl.1

' Begin Tabl.2
If Im21 = "" Then
    frmDatRef.Image21.Picture = frmTolSymbol.Image1.Picture
End If
If Mid(Im21, 1, 1) = Chr(106) Then
    frmDatRef.Image21.Picture = frmTolSymbol.Image2.Picture
End If
If Mid(Im21, 1, 1) = Chr(98) Then
    frmDatRef.Image21.Picture = frmTolSymbol.Image3.Picture
End If
If Mid(Im21, 1, 1) = Chr(102) Then
    frmDatRef.Image21.Picture = frmTolSymbol.Image4.Picture
End If
If Mid(Im21, 1, 1) = Chr(104) Then
    frmDatRef.Image21.Picture = frmTolSymbol.Image5.Picture
End If
If Mid(Im21, 1, 1) = Chr(114) Then
    frmDatRef.Image21.Picture = frmTolSymbol.Image6.Picture
End If
If Mid(Im21, 1, 1) = Chr(105) Then
    frmDatRef.Image21.Picture = frmTolSymbol.Image7.Picture
End If
If Mid(Im21, 1, 1) = Chr(97) Then
    frmDatRef.Image21.Picture = frmTolSymbol.Image8.Picture
End If
If Mid(Im21, 1, 1) = Chr(103) Then
    frmDatRef.Image21.Picture = frmTolSymbol.Image9.Picture
End If
If Mid(Im21, 1, 1) = Chr(99) Then
    frmDatRef.Image21.Picture = frmTolSymbol.Image10.Picture
End If
If Mid(Im21, 1, 1) = Chr(101) Then
    frmDatRef.Image21.Picture = frmTolSymbol.Image11.Picture
End If
If Mid(Im21, 1, 1) = Chr(117) Then
    frmDatRef.Image21.Picture = frmTolSymbol.Image12.Picture
End If
If Mid(Im21, 1, 1) = Chr(100) Then
    frmDatRef.Image21.Picture = frmTolSymbol.Image13.Picture
End If
If Mid(Im21, 1, 1) = Chr(107) Then
    frmDatRef.Image21.Picture = frmTolSymbol.Image14.Picture
End If
If Mid(Im21, 1, 1) = Chr(116) Then
    frmDatRef.Image21.Picture = frmTolSymbol.Image15.Picture
End If

'-------------------------------------------------------
If Im22 = "" Then
    frmDatRef.Image22.Picture = frmTolSymbol.Image1.Picture
End If
If Mid(Im22, 1, 1) = Chr(110) Then
    frmDatRef.Image22.Picture = frmTolSymbol.Image16.Picture
End If
'-------------------------------------------------------
If Im23 = "" Then
    frmDatRef.Image23.Picture = frmTolMC.Image1.Picture
End If
If Mid(Im23, 1, 1) = Chr(109) Then
    frmDatRef.Image23.Picture = frmTolMC.Image17.Picture
End If
If Mid(Im23, 1, 1) = Chr(108) Then
    frmDatRef.Image23.Picture = frmTolMC.Image18.Picture
End If
If Mid(Im23, 1, 1) = Chr(115) Then
    frmDatRef.Image23.Picture = frmTolMC.Image19.Picture
End If
'-------------------------------------------------------
If Im24 = "" Then
    frmDatRef.Image24.Picture = frmTolSymbol.Image1.Picture
End If
If Mid(Im24, 1, 1) = Chr(110) Then
    frmDatRef.Image24.Picture = frmTolSymbol.Image16.Picture
End If
'--------------------------------------------------------
If Im25 = "" Then
    frmDatRef.Image25.Picture = frmTolMC.Image1.Picture
End If
If Mid(Im25, 1, 1) = Chr(109) Then
    frmDatRef.Image25.Picture = frmTolMC.Image17.Picture
End If
If Mid(Im25, 1, 1) = Chr(108) Then
    frmDatRef.Image25.Picture = frmTolMC.Image18.Picture
End If
If Mid(Im25, 1, 1) = Chr(115) Then
    frmDatRef.Image25.Picture = frmTolMC.Image19.Picture
End If
'-------------------------------------------------------
If Im26 = "" Then
    frmDatRef.Image26.Picture = frmTolMC.Image1.Picture
End If
If Mid(Im26, 1, 1) = Chr(109) Then
    frmDatRef.Image26.Picture = frmTolMC.Image17.Picture
End If
If Mid(Im26, 1, 1) = Chr(108) Then
    frmDatRef.Image26.Picture = frmTolMC.Image18.Picture
End If
If Mid(Im26, 1, 1) = Chr(115) Then
    frmDatRef.Image26.Picture = frmTolMC.Image19.Picture
End If
'-------------------------------------------------------
If Im27 = "" Then
    frmDatRef.Image27.Picture = frmTolMC.Image1.Picture
End If
If Mid(Im27, 1, 1) = Chr(109) Then
    frmDatRef.Image27.Picture = frmTolMC.Image17.Picture
End If
If Mid(Im27, 1, 1) = Chr(108) Then
    frmDatRef.Image27.Picture = frmTolMC.Image18.Picture
End If
If Mid(Im27, 1, 1) = Chr(115) Then
    frmDatRef.Image27.Picture = frmTolMC.Image19.Picture
End If
'-------------------------------------------------------
If Im28 = "" Then
    frmDatRef.Image28.Picture = frmTolMC.Image1.Picture
End If
If Mid(Im28, 1, 1) = Chr(109) Then
    frmDatRef.Image28.Picture = frmTolMC.Image17.Picture
End If
If Mid(Im28, 1, 1) = Chr(108) Then
    frmDatRef.Image28.Picture = frmTolMC.Image18.Picture
End If
If Mid(Im28, 1, 1) = Chr(115) Then
    frmDatRef.Image28.Picture = frmTolMC.Image19.Picture
End If

frmDatRef.Text21.Text = Str21
frmDatRef.Text22.Text = Str22
frmDatRef.Text23.Text = Str23
frmDatRef.Text24.Text = Str24
frmDatRef.Text25.Text = Str25

'-------------------------------------------------------
' End Table 2

' Begin Table 3
' ------------------------------------------------
If Im31 = "" Then
    frmDatRef.Image31.Picture = frmTolSymbol.Image1.Picture
End If
If Mid(Im31, 1, 1) = Chr(112) Then
    frmDatRef.Image31.Picture = frmTolSymbol.Image20.Picture
End If
frmDatRef.Text31.Text = Str31

'-------------------------------------------------
' End Table 3

' Begin Table 4
' ------------------------------------------------
frmDatRef.Text41.Text = Str41

'-------------------------------------------------
' End Table 4

' Begin Scale Symbol
' ------------------------------------------------
frmDatRef.ScaleSym.Text = CStr(SymTxtHeight)

'-------------------------------------------------
' End Scale Symbol

End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set App = Nothing
End Sub

Private Sub Help1_Click()
    App.Help , 10500 '141572
End Sub

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Begin Table 1

Private Sub Image11_Click()
    ClIm1 = 1
    frmTolSymbol.Top = frmDatRef.Top + frmDatRef.Image11.Top + frmDatRef.Image11.Height
    frmTolSymbol.Left = frmDatRef.Left + frmDatRef.Image11.Left
    frmTolSymbol.Show vbModal

End Sub

Private Sub Image12_Click()
    ClIm1 = 2
    If Im12 = "" Then
        frmDatRef.Image12.Picture = frmTolSymbol.Image16.Picture
        Im12 = Chr(110)
        Exit Sub
    End If
    If Im12 = Chr(110) Then
        frmDatRef.Image12.Picture = frmTolSymbol.Image1.Picture
        Im12 = ""
    End If

End Sub

Private Sub Image13_Click()
    ClIm1 = 3
    frmTolMC.Top = frmDatRef.Top + frmDatRef.Image13.Top + frmDatRef.Image13.Height
    frmTolMC.Left = frmDatRef.Left + frmDatRef.Image13.Left
    frmTolMC.Show vbModal

End Sub

Private Sub Image14_Click()
    ClIm1 = 4
'    frmTolSymbol.Show vbModal
    If Im14 = "" Then
        frmDatRef.Image14.Picture = frmTolSymbol.Image16.Picture
        Im14 = Chr(110)
        Exit Sub
    End If
    If Im14 = Chr(110) Then
        frmDatRef.Image14.Picture = frmTolSymbol.Image1.Picture
        Im14 = ""
    End If
End Sub

Private Sub Image15_Click()
    ClIm1 = 5
    frmTolMC.Top = frmDatRef.Top + frmDatRef.Image15.Top + frmDatRef.Image15.Height
    frmTolMC.Left = frmDatRef.Left + frmDatRef.Image15.Left
    frmTolMC.Show vbModal
End Sub

Private Sub Image16_Click()
    ClIm1 = 6
    frmTolMC.Top = frmDatRef.Top + frmDatRef.Image16.Top + frmDatRef.Image16.Height
    frmTolMC.Left = frmDatRef.Left + frmDatRef.Image16.Left
    frmTolMC.Show vbModal
End Sub

Private Sub Image17_Click()
    ClIm1 = 7
    frmTolMC.Top = frmDatRef.Top + frmDatRef.Image17.Top + frmDatRef.Image17.Height
    frmTolMC.Left = frmDatRef.Left + frmDatRef.Image17.Left
    frmTolMC.Show vbModal
End Sub

Private Sub Image18_Click()
    ClIm1 = 8
    frmTolMC.Top = frmDatRef.Top + frmDatRef.Image18.Top + frmDatRef.Image18.Height
    frmTolMC.Left = frmDatRef.Left + frmDatRef.Image18.Left
    frmTolMC.Show vbModal
End Sub

Private Sub ScaleSym_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub Text11_Change()
    Str11 = frmDatRef.Text11.Text
End Sub

Private Sub Text11_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub Text12_Change()
    Str12 = frmDatRef.Text12.Text
End Sub

Private Sub Text12_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub Text13_Change()
    Str13 = frmDatRef.Text13.Text
End Sub

Private Sub Text13_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub Text14_Change()
    Str14 = frmDatRef.Text14.Text
End Sub

Private Sub Text14_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub Text15_Change()
    Str15 = frmDatRef.Text15.Text
End Sub
' End Table 1
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Begin Table 2

Private Sub Image21_Click()
    ClIm2 = 1
    frmTolSymbol.Top = frmDatRef.Top + frmDatRef.Image21.Top + frmDatRef.Image21.Height
    frmTolSymbol.Left = frmDatRef.Left + frmDatRef.Image21.Left
    frmTolSymbol.Show vbModal

End Sub

Private Sub Image22_Click()
    ClIm2 = 2
'    frmTolSymbol.Show vbModal
    If Im22 = "" Then
        frmDatRef.Image22.Picture = frmTolSymbol.Image16.Picture
        Im22 = Chr(110)
        Exit Sub
    End If
    If Im22 = Chr(110) Then
        frmDatRef.Image22.Picture = frmTolSymbol.Image1.Picture
        Im22 = ""
    End If
End Sub

Private Sub Image23_Click()
    ClIm2 = 3
    frmTolMC.Top = frmDatRef.Top + frmDatRef.Image23.Top + frmDatRef.Image23.Height
    frmTolMC.Left = frmDatRef.Left + frmDatRef.Image23.Left
    frmTolMC.Show vbModal
End Sub

Private Sub Image24_Click()
    ClIm2 = 4
'    frmTolSymbol.Show vbModal
    If Im24 = "" Then
        frmDatRef.Image24.Picture = frmTolSymbol.Image16.Picture
        Im24 = Chr(110)
        Exit Sub
    End If
    If Im24 = Chr(110) Then
        frmDatRef.Image24.Picture = frmTolSymbol.Image1.Picture
        Im24 = ""
    End If
End Sub

Private Sub Image25_Click()
    ClIm2 = 5
    frmTolMC.Top = frmDatRef.Top + frmDatRef.Image25.Top + frmDatRef.Image25.Height
    frmTolMC.Left = frmDatRef.Left + frmDatRef.Image25.Left
    frmTolMC.Show vbModal
End Sub

Private Sub Image26_Click()
    ClIm2 = 6
    frmTolMC.Top = frmDatRef.Top + frmDatRef.Image26.Top + frmDatRef.Image26.Height
    frmTolMC.Left = frmDatRef.Left + frmDatRef.Image26.Left
    frmTolMC.Show vbModal
End Sub

Private Sub Image27_Click()
    ClIm2 = 7
    frmTolMC.Top = frmDatRef.Top + frmDatRef.Image27.Top + frmDatRef.Image27.Height
    frmTolMC.Left = frmDatRef.Left + frmDatRef.Image27.Left
    frmTolMC.Show vbModal
End Sub

Private Sub Image28_Click()
    ClIm2 = 8
    frmTolMC.Top = frmDatRef.Top + frmDatRef.Image28.Top + frmDatRef.Image28.Height
    frmTolMC.Left = frmDatRef.Left + frmDatRef.Image28.Left
    frmTolMC.Show vbModal
End Sub

Private Sub Text15_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub Text21_Change()
    Str21 = frmDatRef.Text21.Text
End Sub

Private Sub Text21_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub Text22_Change()
    Str22 = frmDatRef.Text22.Text
End Sub

Private Sub Text22_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub Text23_Change()
    Str23 = frmDatRef.Text23.Text
End Sub

Private Sub Text23_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub Text24_Change()
    Str24 = frmDatRef.Text24.Text
End Sub

Private Sub Text24_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub Text25_Change()
    Str25 = frmDatRef.Text25.Text
End Sub

' End Table 2
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Begin Table 3

Private Sub Image31_Click()
    ClIm3 = 1
'    frmTolSymbol.Show vbModal
    If Im31 = "" Then
        frmDatRef.Image31.Picture = frmTolSymbol.Image20.Picture
        Im31 = Chr(112)
        Exit Sub
    End If
    If Im31 = Chr(112) Then
        frmDatRef.Image31.Picture = frmTolSymbol.Image1.Picture
        Im31 = ""
    End If

End Sub

Private Sub Text25_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub Text31_Change()
    Str31 = frmDatRef.Text31.Text
End Sub

Private Sub Text31_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

' End Table 3
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Begin Table 4

Private Sub Text41_Change()
    Str41 = frmDatRef.Text41.Text
End Sub
' End Table 3
' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

' Begin Scale
Private Sub ScaleSym_Change()
'    SymTxtHeight = CDbl(frmDatRef.ScaleSym.Text)
End Sub

Private Sub EscClick()
    Im11 = Im110
    Im12 = Im120
    Im13 = Im130
    Im14 = Im140
    Im15 = Im150
    Im16 = Im160
    Im17 = Im170
    Im18 = Im180
    Str11 = Str110
    Str12 = Str120
    Str13 = Str130
    Str14 = Str140
    Str15 = Str150

    Im21 = Im210
    Im22 = Im220
    Im23 = Im230
    Im24 = Im240
    Im25 = Im250
    Im26 = Im260
    Im27 = Im270
    Im28 = Im280
    Str21 = Str210
    Str22 = Str220
    Str23 = Str230
    Str24 = Str240
    Str25 = Str250

    Im31 = Im310
    Str31 = Str310

    Str41 = Str410

    SymTxtHeight = SymTxtHeight0

    TextF = TextF0

    blnDialogCanceled = True

    Me.Hide

End Sub

Private Sub Text41_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub


Examples - Tolerance Symbol Regen - TolMC.frm

TolMC.frm

Tolerance Symbol Regen Example

VERSION 5.00
Begin VB.Form frmTolMC
   BackColor       =   &H00808000&
   ClientHeight    =   1515
   ClientLeft      =   60
   ClientTop       =   60
   ClientWidth     =   360
   ControlBox      =   0   'False
   LinkTopic       =   "Form2"
   ScaleHeight     =   1515
   ScaleWidth      =   360
   StartUpPosition =   3  'Windows Default
   Begin VB.Line Line1
      X1              =   0
      X2              =   360
      Y1              =   360
      Y2              =   360
   End
   Begin VB.Image Image17
      Height          =   360
      Left            =   0
      Picture         =   "TolMC.frx":0000
      ToolTipText     =   "At Maximum Material Condition"
      Top             =   390
      Width           =   360
   End
   Begin VB.Image Image18
      Height          =   360
      Left            =   0
      Picture         =   "TolMC.frx":01A2
      ToolTipText     =   "At Least Material Condition"
      Top             =   780
      Width           =   360
   End
   Begin VB.Image Image19
      Height          =   360
      Left            =   0
      Picture         =   "TolMC.frx":0344
      ToolTipText     =   "Regardless of Feature Size"
      Top             =   1170
      Width           =   360
   End
   Begin VB.Image Image1
      Height          =   360
      Left            =   0
      Picture         =   "TolMC.frx":04E6
      Top             =   0
      Width           =   360
   End
End
Attribute VB_Name = "frmTolMC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdCancel_Click()
    ClIm = 0
    Me.Hide
End Sub

Private Sub OldcmdOK_Click()
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Me.Hide
End Sub

Private Sub Image1_Click()
'------------------------------------------------------------
' Begin Table 1
    If ClIm1 = 3 Then
        frmDatRef.Image13.Picture = frmTolSymbol.Image1.Picture
        Im13 = ""
    End If
    If ClIm1 = 5 Then
        frmDatRef.Image15.Picture = frmTolSymbol.Image1.Picture
        Im15 = ""
    End If
    If ClIm1 = 6 Then
        frmDatRef.Image16.Picture = frmTolSymbol.Image1.Picture
        Im16 = ""
    End If
    If ClIm1 = 7 Then
        frmDatRef.Image17.Picture = frmTolSymbol.Image1.Picture
        Im17 = ""
    End If
    If ClIm1 = 8 Then
        frmDatRef.Image18.Picture = frmTolSymbol.Image1.Picture
        Im18 = ""
    End If
' End Table 1
'---------------------------------------------------------
'------------------------------------------------------------
' Begin Table 2
    If ClIm2 = 3 Then
        frmDatRef.Image23.Picture = frmTolSymbol.Image1.Picture
        Im23 = ""
    End If
    If ClIm2 = 5 Then
        frmDatRef.Image25.Picture = frmTolSymbol.Image1.Picture
        Im25 = ""
    End If
    If ClIm2 = 6 Then
        frmDatRef.Image26.Picture = frmTolSymbol.Image1.Picture
        Im26 = ""
    End If
    If ClIm2 = 7 Then
        frmDatRef.Image27.Picture = frmTolSymbol.Image1.Picture
        Im27 = ""
    End If
    If ClIm2 = 8 Then
        frmDatRef.Image28.Picture = frmTolSymbol.Image1.Picture
        Im28 = ""
    End If
' End Table 2
'---------------------------------------------------------
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0

    Me.Hide

End Sub

Private Sub Image17_Click()
' Table 1
    If ClIm1 = 3 Then
        frmDatRef.Image13.Picture = frmTolMC.Image17.Picture
        Im13 = Chr(109)
    End If
    If ClIm1 = 5 Then
        frmDatRef.Image15.Picture = frmTolMC.Image17.Picture
        Im15 = Chr(109)
    End If
    If ClIm1 = 6 Then
        frmDatRef.Image16.Picture = frmTolMC.Image17.Picture
        Im16 = Chr(109)
    End If
    If ClIm1 = 7 Then
        frmDatRef.Image17.Picture = frmTolMC.Image17.Picture
        Im17 = Chr(109)
    End If
    If ClIm1 = 8 Then
        frmDatRef.Image18.Picture = frmTolMC.Image17.Picture
        Im18 = Chr(109)
    End If

 ' Table 2
    If ClIm2 = 3 Then
        frmDatRef.Image23.Picture = frmTolMC.Image17.Picture
        Im23 = Chr(109)
    End If
    If ClIm2 = 5 Then
        frmDatRef.Image25.Picture = frmTolMC.Image17.Picture
        Im25 = Chr(109)
    End If
    If ClIm2 = 6 Then
        frmDatRef.Image26.Picture = frmTolMC.Image17.Picture
        Im26 = Chr(109)
    End If
    If ClIm2 = 7 Then
        frmDatRef.Image27.Picture = frmTolMC.Image17.Picture
        Im27 = Chr(109)
    End If
    If ClIm2 = 8 Then
        frmDatRef.Image28.Picture = frmTolMC.Image17.Picture
        Im28 = Chr(109)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0

    Me.Hide

End Sub

Private Sub Image18_Click()

' Table 1
    If ClIm1 = 3 Then
        frmDatRef.Image13.Picture = frmTolMC.Image18.Picture
        Im13 = Chr(108)
    End If
    If ClIm1 = 5 Then
        frmDatRef.Image15.Picture = frmTolMC.Image18.Picture
        Im15 = Chr(108)
    End If
    If ClIm1 = 6 Then
        frmDatRef.Image16.Picture = frmTolMC.Image18.Picture
        Im16 = Chr(108)
    End If
    If ClIm1 = 7 Then
        frmDatRef.Image17.Picture = frmTolMC.Image18.Picture
        Im17 = Chr(108)
    End If
    If ClIm1 = 8 Then
        frmDatRef.Image18.Picture = frmTolMC.Image18.Picture
        Im18 = Chr(108)
    End If

 ' Table 2
    If ClIm2 = 3 Then
        frmDatRef.Image23.Picture = frmTolMC.Image18.Picture
        Im23 = Chr(108)
    End If
    If ClIm2 = 5 Then
        frmDatRef.Image25.Picture = frmTolMC.Image18.Picture
        Im25 = Chr(108)
    End If
    If ClIm2 = 6 Then
        frmDatRef.Image26.Picture = frmTolMC.Image18.Picture
        Im26 = Chr(108)
    End If
    If ClIm2 = 7 Then
        frmDatRef.Image27.Picture = frmTolMC.Image18.Picture
        Im27 = Chr(108)
    End If
    If ClIm2 = 8 Then
        frmDatRef.Image28.Picture = frmTolMC.Image18.Picture
        Im28 = Chr(108)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0

    Me.Hide

End Sub

Private Sub Image19_Click()

' Table 1
    If ClIm1 = 3 Then
        frmDatRef.Image13.Picture = frmTolMC.Image19.Picture
        Im13 = Chr(115)
    End If
    If ClIm1 = 5 Then
        frmDatRef.Image15.Picture = frmTolMC.Image19.Picture
        Im15 = Chr(115)
    End If
    If ClIm1 = 6 Then
        frmDatRef.Image16.Picture = frmTolMC.Image19.Picture
        Im16 = Chr(115)
    End If
    If ClIm1 = 7 Then
        frmDatRef.Image17.Picture = frmTolMC.Image19.Picture
        Im17 = Chr(115)
    End If
    If ClIm1 = 8 Then
        frmDatRef.Image18.Picture = frmTolMC.Image19.Picture
        Im18 = Chr(115)
    End If

 ' Table 2
    If ClIm2 = 3 Then
        frmDatRef.Image23.Picture = frmTolMC.Image19.Picture
        Im23 = Chr(115)
    End If
    If ClIm2 = 5 Then
        frmDatRef.Image25.Picture = frmTolMC.Image19.Picture
        Im25 = Chr(115)
    End If
    If ClIm2 = 6 Then
        frmDatRef.Image26.Picture = frmTolMC.Image19.Picture
        Im26 = Chr(115)
    End If
    If ClIm2 = 7 Then
        frmDatRef.Image27.Picture = frmTolMC.Image19.Picture
        Im27 = Chr(115)
    End If
    If ClIm2 = 8 Then
        frmDatRef.Image28.Picture = frmTolMC.Image19.Picture
        Im28 = Chr(115)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0

    Me.Hide

End Sub


Examples - Tolerance Symbol Regen - TolSymbol.frm

TolSymbol.frm

Tolerance Symbol Regen Example

VERSION 5.00
Begin VB.Form frmTolSymbol
   BackColor       =   &H00808000&
   ClientHeight    =   2475
   ClientLeft      =   60
   ClientTop       =   60
   ClientWidth     =   1515
   ControlBox      =   0   'False
   FillColor       =   &H00FFFFFF&
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   ScaleHeight     =   2475
   ScaleWidth      =   1515
   Visible         =   0   'False
   Begin VB.Image Image20
      Height          =   360
      Left            =   720
      Picture         =   "TolSymbol.frx":0000
      Top             =   2760
      Visible         =   0   'False
      Width           =   360
   End
   Begin VB.Image Image16
      Height          =   360
      Left            =   240
      Picture         =   "TolSymbol.frx":01A2
      Top             =   2760
      Visible         =   0   'False
      Width           =   360
   End
   Begin VB.Image Image15
      Height          =   360
      Left            =   1080
      Picture         =   "TolSymbol.frx":0344
      ToolTipText     =   "Total Runout"
      Top             =   2040
      Width           =   360
   End
   Begin VB.Image Image14
      Height          =   360
      Left            =   600
      Picture         =   "TolSymbol.frx":04E6
      ToolTipText     =   "Profile of a Line"
      Top             =   2040
      Width           =   360
   End
   Begin VB.Image Image13
      Height          =   360
      Left            =   120
      Picture         =   "TolSymbol.frx":0688
      ToolTipText     =   "Profile of a Surface"
      Top             =   2040
      Width           =   360
   End
   Begin VB.Image Image12
      Height          =   360
      Left            =   1080
      Picture         =   "TolSymbol.frx":082A
      ToolTipText     =   "Straightness"
      Top             =   1560
      Width           =   360
   End
   Begin VB.Image Image11
      Height          =   360
      Left            =   600
      Picture         =   "TolSymbol.frx":09CC
      ToolTipText     =   "Circularity"
      Top             =   1560
      Width           =   360
   End
   Begin VB.Image Image10
      Height          =   360
      Left            =   120
      Picture         =   "TolSymbol.frx":0B6E
      ToolTipText     =   "Flatness"
      Top             =   1560
      Width           =   360
   End
   Begin VB.Image Image9
      Height          =   360
      Left            =   1080
      Picture         =   "TolSymbol.frx":0D10
      ToolTipText     =   "Cylindricity"
      Top             =   1080
      Width           =   360
   End
   Begin VB.Image Image8
      Height          =   360
      Left            =   600
      Picture         =   "TolSymbol.frx":0EB2
      ToolTipText     =   "Angularity"
      Top             =   1080
      Width           =   360
   End
   Begin VB.Image Image7
      Height          =   360
      Left            =   120
      Picture         =   "TolSymbol.frx":1054
      ToolTipText     =   "Symmerty"
      Top             =   1080
      Width           =   360
   End
   Begin VB.Image Image6
      Height          =   360
      Left            =   1080
      Picture         =   "TolSymbol.frx":11F6
      ToolTipText     =   "Concentricity/Coaxiality"
      Top             =   600
      Width           =   360
   End
   Begin VB.Image Image5
      Height          =   360
      Left            =   600
      Picture         =   "TolSymbol.frx":1398
      ToolTipText     =   "Circular Runout"
      Top             =   600
      Width           =   360
   End
   Begin VB.Image Image4
      Height          =   360
      Left            =   120
      Picture         =   "TolSymbol.frx":153A
      ToolTipText     =   "Parallelism"
      Top             =   600
      Width           =   360
   End
   Begin VB.Image Image3
      Height          =   360
      Left            =   1080
      Picture         =   "TolSymbol.frx":16DC
      ToolTipText     =   "Perpendicularity"
      Top             =   120
      Width           =   360
   End
   Begin VB.Image Image2
      Height          =   360
      Left            =   600
      Picture         =   "TolSymbol.frx":187E
      ToolTipText     =   "Position"
      Top             =   120
      Width           =   360
   End
   Begin VB.Image Image1
      Height          =   360
      Left            =   120
      Picture         =   "TolSymbol.frx":1A20
      Top             =   120
      Width           =   360
   End
End
Attribute VB_Name = "frmTolSymbol"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub cmdCancel_Click()

End Sub

Private Sub cmdHelp_Click()
    Me.Hide
End Sub

Private Sub OldcmdOK_Click()
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Me.Hide
End Sub

Private Sub Image1_Click()

'------------------------------------------------------------
' Begin Table 1
    If ClIm1 = 1 Then
        frmDatRef.Image11.Picture = frmTolSymbol.Image1.Picture
        Im11 = ""
    End If
    If ClIm1 = 2 Then
        frmDatRef.Image12.Picture = frmTolSymbol.Image1.Picture
        Im12 = ""
    End If
    If ClIm1 = 3 Then
        frmDatRef.Image13.Picture = frmTolSymbol.Image1.Picture
        Im13 = ""
    End If
    If ClIm1 = 4 Then
        frmDatRef.Image14.Picture = frmTolSymbol.Image1.Picture
        Im14 = ""
    End If
    If ClIm1 = 5 Then
        frmDatRef.Image15.Picture = frmTolSymbol.Image1.Picture
        Im15 = ""
    End If
    If ClIm1 = 6 Then
        frmDatRef.Image16.Picture = frmTolSymbol.Image1.Picture
        Im16 = ""
    End If
    If ClIm1 = 7 Then
        frmDatRef.Image17.Picture = frmTolSymbol.Image1.Picture
        Im17 = ""
    End If
    If ClIm1 = 8 Then
        frmDatRef.Image18.Picture = frmTolSymbol.Image1.Picture
        Im18 = ""
    End If
' End Table 1
'---------------------------------------------------------

'------------------------------------------------------------
' Begin Table 2
    If ClIm2 = 1 Then
        frmDatRef.Image21.Picture = frmTolSymbol.Image1.Picture
        Im21 = ""
    End If
    If ClIm2 = 2 Then
        frmDatRef.Image22.Picture = frmTolSymbol.Image1.Picture
        Im22 = ""
    End If
    If ClIm2 = 3 Then
        frmDatRef.Image23.Picture = frmTolSymbol.Image1.Picture
        Im23 = ""
    End If
    If ClIm2 = 4 Then
        frmDatRef.Image24.Picture = frmTolSymbol.Image1.Picture
        Im24 = ""
    End If
    If ClIm2 = 5 Then
        frmDatRef.Image25.Picture = frmTolSymbol.Image1.Picture
        Im25 = ""
    End If
    If ClIm2 = 6 Then
        frmDatRef.Image26.Picture = frmTolSymbol.Image1.Picture
        Im26 = ""
    End If
    If ClIm2 = 7 Then
        frmDatRef.Image27.Picture = frmTolSymbol.Image1.Picture
        Im27 = ""
    End If
    If ClIm2 = 8 Then
        frmDatRef.Image28.Picture = frmTolSymbol.Image1.Picture
        Im28 = ""
    End If
' End Table 2
'---------------------------------------------------------

'------------------------------------------------------------
' Begin Table 3
    If ClIm3 = 1 Then
        frmDatRef.Image31.Picture = frmTolSymbol.Image1.Picture
        Im31 = ""
    End If
' End Table 3
'---------------------------------------------------------
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image2_Click()
    If ClIm1 = 1 Then
        frmDatRef.Image11.Picture = frmTolSymbol.Image2.Picture
'        Im11 = 2
        Im11 = Chr(106)
    End If
    If ClIm2 = 1 Then
        frmDatRef.Image21.Picture = frmTolSymbol.Image2.Picture
'        Im21 = 2
        Im21 = Chr(106)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image3_Click()
    If ClIm1 = 1 Then
        frmDatRef.Image11.Picture = frmTolSymbol.Image3.Picture
'        Im11 = 3
        Im11 = Chr(98)
    End If
    If ClIm2 = 1 Then
        frmDatRef.Image21.Picture = frmTolSymbol.Image3.Picture
'        Im21 = 3
        Im21 = Chr(98)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image4_Click()
    If ClIm1 = 1 Then
        frmDatRef.Image11.Picture = frmTolSymbol.Image4.Picture
'        Im11 = 4
        Im11 = Chr(102)
    End If
    If ClIm2 = 1 Then
        frmDatRef.Image21.Picture = frmTolSymbol.Image4.Picture
'        Im21 = 4
        Im21 = Chr(102)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image5_Click()
    If ClIm1 = 1 Then
        frmDatRef.Image11.Picture = frmTolSymbol.Image5.Picture
'        Im11 = 5
        Im11 = Chr(104)
    End If
    If ClIm2 = 1 Then
        frmDatRef.Image21.Picture = frmTolSymbol.Image5.Picture
'        Im21 = 5
        Im21 = Chr(104)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image6_Click()
    If ClIm1 = 1 Then
        frmDatRef.Image11.Picture = frmTolSymbol.Image6.Picture
'        Im11 = 6
        Im11 = Chr(114)
    End If
    If ClIm2 = 1 Then
        frmDatRef.Image21.Picture = frmTolSymbol.Image6.Picture
'        Im21 = 6
        Im21 = Chr(114)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image7_Click()
    If ClIm1 = 1 Then
        frmDatRef.Image11.Picture = frmTolSymbol.Image7.Picture
'        Im11 = 7
        Im11 = Chr(105)
    End If
    If ClIm2 = 1 Then
        frmDatRef.Image21.Picture = frmTolSymbol.Image7.Picture
'        Im21 = 7
        Im21 = Chr(105)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image8_Click()
    If ClIm1 = 1 Then
        frmDatRef.Image11.Picture = frmTolSymbol.Image8.Picture
'        Im11 = 8
        Im11 = Chr(97)
    End If
    If ClIm2 = 1 Then
        frmDatRef.Image21.Picture = frmTolSymbol.Image8.Picture
'        Im21 = 8
        Im21 = Chr(97)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image9_Click()
    If ClIm1 = 1 Then
        frmDatRef.Image11.Picture = frmTolSymbol.Image9.Picture
'        Im11 = 9
        Im11 = Chr(103)
    End If
    If ClIm2 = 1 Then
        frmDatRef.Image21.Picture = frmTolSymbol.Image9.Picture
'        Im21 = 9
        Im21 = Chr(103)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image10_Click()
    If ClIm1 = 1 Then
        frmDatRef.Image11.Picture = frmTolSymbol.Image10.Picture
'        Im11 = 10
        Im11 = Chr(99)
    End If
    If ClIm2 = 1 Then
        frmDatRef.Image21.Picture = frmTolSymbol.Image10.Picture
'        Im21 = 10
        Im21 = Chr(99)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image11_Click()
    If ClIm1 = 1 Then
        frmDatRef.Image11.Picture = frmTolSymbol.Image11.Picture
'        Im11 = 11
        Im11 = Chr(101)
    End If
    If ClIm2 = 1 Then
        frmDatRef.Image21.Picture = frmTolSymbol.Image11.Picture
'        Im21 = 11
        Im21 = Chr(101)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image12_Click()
    If ClIm1 = 1 Then
        frmDatRef.Image11.Picture = frmTolSymbol.Image12.Picture
'        Im11 = 12
        Im11 = Chr(117)
    End If
    If ClIm2 = 1 Then
        frmDatRef.Image21.Picture = frmTolSymbol.Image12.Picture
'        Im21 = 12
        Im21 = Chr(117)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image13_Click()
    If ClIm1 = 1 Then
        frmDatRef.Image11.Picture = frmTolSymbol.Image13.Picture
'        Im11 = 13
        Im11 = Chr(100)
    End If
    If ClIm2 = 1 Then
        frmDatRef.Image21.Picture = frmTolSymbol.Image13.Picture
'        Im21 = 13
        Im21 = Chr(100)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image14_Click()
    If ClIm1 = 1 Then
        frmDatRef.Image11.Picture = frmTolSymbol.Image14.Picture
'        Im11 = 14
        Im11 = Chr(107)
    End If
    If ClIm2 = 1 Then
        frmDatRef.Image21.Picture = frmTolSymbol.Image14.Picture
'        Im21 = 14
        Im21 = Chr(107)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image15_Click()
    If ClIm1 = 1 Then
        frmDatRef.Image11.Picture = frmTolSymbol.Image15.Picture
'        Im11 = 15
        Im11 = Chr(116)
    End If
    If ClIm2 = 1 Then
        frmDatRef.Image21.Picture = frmTolSymbol.Image15.Picture
'        Im21 = 15
        Im21 = Chr(116)
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image16_Click()
' Table 1
    If ClIm1 = 2 Then
        frmDatRef.Image12.Picture = frmTolSymbol.Image16.Picture
        Im12 = 2
    End If
    If ClIm1 = 4 Then
        frmDatRef.Image14.Picture = frmTolSymbol.Image16.Picture
        Im14 = 2
    End If
' Table 2
    If ClIm2 = 2 Then
        frmDatRef.Image22.Picture = frmTolSymbol.Image16.Picture
        Im22 = 2
    End If
    If ClIm2 = 4 Then
        frmDatRef.Image24.Picture = frmTolSymbol.Image16.Picture
        Im24 = 2
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub

Private Sub Image20_Click()
    If ClIm3 = 1 Then
        frmDatRef.Image31.Picture = frmTolSymbol.Image20.Picture
        Im31 = 2
    End If
    ClIm1 = 0
    ClIm2 = 0
    ClIm3 = 0
    Me.Hide

End Sub


Examples - Gear Regen - Gear.bas

Gear.bas

Gear Regen Example

Attribute VB_Name = "modGear"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' DLL Entry point
Sub Main()

End Sub


Examples - Gear Regen - Gear.cls

Gear.cls

Gear Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Bearing"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idTeethNum = 1
Const IdD0 = 2
Const idH0 = 3
Const IdD1 = 4
Const IdD2 = 5
Const idH1 = 6
Const IdDi = 7
Const idH2 = 8
Const idH3 = 9
Const idH4 = 10
'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 10
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "SDK Gear"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{D25185FF-6A20-11d0-A115-00A024158DAF}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
' Number of teeth on the gear
    Names(0) = "TeethNum"
    Types(0) = typeInteger
    IDs(0) = idTeethNum
    Defaults(0) = 40

    Names(1) = "D0"
    Types(1) = typeDouble
    IDs(1) = IdD0
    Defaults(1) = 3.5

    Names(2) = "H0"
    Types(2) = typeDouble
    IDs(2) = idH0
    Defaults(2) = 0.5

    Names(3) = "D1"
    Types(3) = typeDouble
    IDs(3) = IdD1
    Defaults(3) = 2.5

    Names(4) = "D2"
    Types(4) = typeDouble
    IDs(4) = IdD2
    Defaults(4) = 1.5

    Names(5) = "H1"
    Types(5) = typeDouble
    IDs(5) = idH1
    Defaults(5) = 0.25

    Names(6) = "Di"
    Types(6) = typeDouble
    IDs(6) = IdDi
    Defaults(6) = 1#

    Names(7) = "H2"
    Types(7) = typeDouble
    IDs(7) = idH2
    Defaults(7) = 0.75

    Names(8) = "H3"
    Types(8) = typeDouble
    IDs(8) = idH3
    Defaults(8) = 1.5

    Names(9) = "H4"
    Types(9) = typeDouble
    IDs(9) = idH4
    Defaults(9) = 1#

    GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmGear
    Names(0) = frmGear.Caption
    Unload frmGear

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
    GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed

        Dim TeethNum%, D0#, H0#, D1#, D2#, H1#, Di#, H2#, H3#, H4#
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmGear
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next

                'When the property page is closed, transfer the numeric
                'roundness value from the TextBox to the Graphic
                'Get the value as a double-precision number
                TeethNum = CInt(.txtTeethNum.Text)
                D0 = CDbl(.OutsideDiam.Text)
                H0 = CDbl(.H0.Text)
                D1 = CDbl(.D1.Text)
                D2 = CDbl(.D2.Text)
                H1 = CDbl(.H1.Text)
                Di = CDbl(.Di.Text)
                H2 = CDbl(.H2.Text)
                H3 = CDbl(.H3.Text)
                H4 = CDbl(.H4.Text)

                'Make sure it's between 0 and 100
                If TeethNum < 10 Then TeethNum = 10
                If D0 < 0 Then D0 = 1
'                If Roundness# > 100# Then Roundness# = 100#
                'Set the roundness property value in the Graphic
                Graphic.Properties("TeethNum") = TeethNum
                Graphic.Properties("D0") = D0
                Graphic.Properties("H0") = H0
                Graphic.Properties("D1") = D1
                Graphic.Properties("D2") = D2
                Graphic.Properties("H1") = H1
                Graphic.Properties("Di") = Di
                Graphic.Properties("H2") = H2
                Graphic.Properties("H3") = H3
                Graphic.Properties("H4") = H4

            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmGear
            With frmGear
                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                'roundness value from the Graphic to the TextBox
                'Get the roundness property value from the Graphic
                TeethNum = Graphic.Properties("TeethNum")
                D0 = Graphic.Properties("D0")
                H0 = Graphic.Properties("H0")
                D1 = Graphic.Properties("D1")
                D2 = Graphic.Properties("D2")
                H1 = Graphic.Properties("H1")
                Di = Graphic.Properties("Di")
                H2 = Graphic.Properties("H2")
                H3 = Graphic.Properties("H3")
                H4 = Graphic.Properties("H4")
               'Set the TextBox control's text
                .txtTeethNum.Text = CStr(TeethNum)
                .OutsideDiam.Text = CStr(D0)
                .H0.Text = CStr(H0)
                .D1.Text = CStr(D1)
                .D2.Text = CStr(D2)
                .H1.Text = CStr(H1)
                .Di.Text = CStr(Di)
                .H2.Text = CStr(H2)
                .H3.Text = CStr(H3)
                .H4.Text = CStr(H4)
NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
'            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmGear
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmGear
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If

    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "Center" of detail
    grfThis.Vertices.Add 5#, 5#, 0#, False, True, False, False, False
    'Second Vertex is "upper right" corner
'    grfThis.Vertices.Add 5#, 5#, 3#, False, True, False, False, False

    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis As Object)
        'Setup error handler
        On Error GoTo Failed

        'grfThis.Application.PushVertexDefaults Editable:=True, Selectable:=True

        'Set up lock (prevent recursion)
        Dim LockCount&
        LockCount& = grfThis.RegenLock
Dim NumCosm As Long, iCosm As Long
        iCosm = 1
        NumCosm = grfThis.Graphics.Count
        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
'            grfThis.Graphics.Clear gfCosmetic

            'Add child Graphics
            Dim grfChild As Object
            Dim x0#, y0#, Z0#, x1#, y1#, Z1#
            With grfThis.Vertices
                x0# = .Item(0).X
                y0# = .Item(0).Y
                Z0# = .Item(0).Z
'                x1# = .Item(1).X
'                y1# = .Item(1).Y
'                Z1# = .Item(1).Z
            End With
Dim TeethNum%
        TeethNum = grfThis.Properties("TeethNum")

Dim D0#, D1# 'External diameter
        D0 = grfThis.Properties("D0")
        D1 = grfThis.Properties("D1")

Dim n As Long
    n = TeethNum
Dim Rext#, Rint#, r1#, r2#, r3#
Dim fi#, dfi#, alp#, bet#, gam#
Dim xc#, yc#, zc#
Dim h#, H0#, H2#, H3#, H4#, H1#
        H0 = grfThis.Properties("H0")
Dim i As Long, j As Long
    Rext = D0 / 2
Dim m#
    m = D0 / (n + 2)
    h = 2.25 * m
    Rint = Rext - h
    r1 = D1 / 2
    xc = x0
    yc = y0
    zc = Z0 - H0
    dfi = 2 * Pi / n
    alp = Pi / 3 / n
    bet = Pi / 3 / n
    gam = Pi / 3 / n
Dim Vers As Vertices
Dim Ver As Vertex
Dim xi#, yi#, zi#
Dim grChild As Graphic
    zi = zc
    j = 0
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If

'###############################################################
    Set Vers = grChild.Vertices
    For i = 0 To n - 1
        fi = i * dfi
        If i = 0 Then
            xi = xc + Rint * Cos(fi - (alp + bet))
            yi = yc + Rint * Sin(fi - (alp + bet))
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
        j = j + 1
        xi = xc + Rext * Cos(fi - alp)
        yi = yc + Rext * Sin(fi - alp)
        Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        xi = xc + Rext * Cos(fi + alp)
        yi = yc + Rext * Sin(fi + alp)
        Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        xi = xc + Rint * Cos(fi + (alp + bet))
        yi = yc + Rint * Sin(fi + (alp + bet))
        Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        xi = xc + Rint * Cos(fi + (alp + bet + 2 * gam))
        yi = yc + Rint * Sin(fi + (alp + bet + 2 * gam))
        Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
    Next i
Dim xCon#, yCon#, zCon#
    xCon = xi
    yCon = yi
    zCon = zi

    dfi = 2 * Pi / 30
    For i = 0 To 30
        fi = -i * dfi
        xi = xc + r1 * Cos(fi)
        yi = yc + r1 * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False, True, True, True, True, False)

    grChild.Closed = True
    grChild.Properties("PenColor") = QBColor(8)
    grChild.Properties("Thickness") = 2 * H0
    grChild.Properties("Solid") = 0

' ----------------------------------------------------------------------
Dim D2#
        D2 = grfThis.Properties("D2")
        H1 = grfThis.Properties("H1")
    r1 = D1 / 2
    r2 = D2 / 2
    xc = x0
    yc = y0
    zc = Z0 - H1
    zi = zc
    dfi = 2 * Pi / 30
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################

    For i = 0 To 30
        fi = i * dfi
        xi = xc + r1 * Cos(fi)
        yi = yc + r1 * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + r2 * Cos(fi)
        yi = yc + r2 * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False, True, True, True, True, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = QBColor(8)
    grChild.Properties("Thickness") = 2 * H1
    grChild.Properties("Solid") = 0

' ----------------------------------------------------------------------
Dim Di#, ri#
        Di = grfThis.Properties("Di")
        H2 = grfThis.Properties("H2")
    r2 = D2 / 2
    ri = Di / 2
    xc = x0
    yc = y0
    zc = Z0 - H2
    zi = zc
    dfi = 2 * Pi / 30
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################
    For i = 0 To 30
        fi = i * dfi
        xi = xc + r2 * Cos(fi)
        yi = yc + r2 * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + ri * Cos(fi)
        yi = yc + ri * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False, True, True, True, True, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = QBColor(8)
    grChild.Properties("Thickness") = 2 * H2
    grChild.Properties("Solid") = 0
' ----------------------------------------------------------------------
    H3 = grfThis.Properties("H3")
'    r3 = 0.25 * Rint
    xc = x0
    yc = y0
'    H4 = H1 * 3
    zc = Z0 - H3
    zi = zc
    dfi = 2 * Pi / 30
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################
    For i = 0 To 30
        fi = i * dfi
        xi = xc + ri * Cos(fi)
        yi = yc + ri * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    grChild.Closed = True
    grChild.Properties("PenColor") = QBColor(8)
    grChild.Properties("Thickness") = 2 * H3
    grChild.Properties("Solid") = 0

' End gear
' --------------------------------------------------------------------------
' --------------------------------------------------------------------------
' --------------------------------------------------------------------------
' Begin Bearings  -  1
    H4 = grfThis.Properties("H4")

 Dim rb1#, rb2#, rb3#, rb4#
 Dim hb#
 Dim rr#
 Dim zb#
    rr = 0.2 * ri
    hb = 2 * rr
    zb = H4

'  First ring
    rb1 = ri
    rb2 = rb1 + hb / 4
    xc = x0
    yc = y0
    zi = zb
    dfi = 2 * Pi / 30
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################
    For i = 0 To 30
        fi = i * dfi
        xi = xc + rb2 * Cos(fi)
        yi = yc + rb2 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + rb1 * Cos(fi)
        yi = yc + rb1 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False, True, True, True, True, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = RGB(0, 0, 255)
    grChild.Properties("Thickness") = hb
    grChild.Properties("Solid") = 0
' --------------------------------------------------------------------

'  Second ring
    rb3 = rb2 + 2 * rr
    rb4 = rb3 + hb / 4
    xc = x0
    yc = y0
    zi = zb
    dfi = 2 * Pi / 30
 '###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################
   For i = 0 To 30
        fi = i * dfi
        xi = xc + rb4 * Cos(fi)
        yi = yc + rb4 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + rb3 * Cos(fi)
        yi = yc + rb3 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False, True, True, True, True, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = RGB(0, 0, 255)
    grChild.Properties("Thickness") = hb
    grChild.Properties("Solid") = 0
' --------------------------------------------------------------------
' Draw Bolls as spheres
    zi = zb + hb / 2
    dfi = 2 * Pi / 16
    For i = 0 To 16
        fi = i * dfi
        xi = xc + (rb2 + rr) * Cos(fi)
        yi = yc + (rb2 + rr) * Sin(fi)
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(, "TCW40SPHERE")
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################

'        Set grChild = grfThis.Graphics.Add(, "TCW40SPHERE")
'                grChild.Cosmetic = True
        Set Ver = grChild.Vertices.Add(xi, yi, zi, False, False, False, False, False, False)
        Set Ver = grChild.Vertices.Add(xi, yi, zi + rr, False, False, False, False, False, False)
        grChild.Properties("PenColor") = QBColor(4)
        grChild.Properties("Solid") = 0
    Next i

' --------------------------------------------------------------------------
' --------------------------------------------------------------------------
' --------------------------------------------------------------------------
' Begin Bearings  -  2
    rr = 0.2 * ri
    hb = 2 * rr
    zb = -H4 - hb

'  First ring
    rb1 = ri
    rb2 = rb1 + hb / 4
    xc = x0
    yc = y0
    zi = zb
    dfi = 2 * Pi / 30
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################
    For i = 0 To 30
        fi = i * dfi
        xi = xc + rb2 * Cos(fi)
        yi = yc + rb2 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + rb1 * Cos(fi)
        yi = yc + rb1 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False, True, True, True, True, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = RGB(0, 0, 255)
    grChild.Properties("Thickness") = hb
    grChild.Properties("Solid") = 0
' --------------------------------------------------------------------

'  Second ring
    rb3 = rb2 + 2 * rr
    rb4 = rb3 + hb / 4
    xc = x0
    yc = y0
    zi = zb
    dfi = 2 * Pi / 30
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(11)
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################
    For i = 0 To 30
        fi = i * dfi
        xi = xc + rb4 * Cos(fi)
        yi = yc + rb4 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + rb3 * Cos(fi)
        yi = yc + rb3 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False, True, True, True, True, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True, True, True, True, True, False)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False, True, True, True, True, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = RGB(0, 0, 255)
    grChild.Properties("Thickness") = hb
    grChild.Properties("Solid") = 0
' --------------------------------------------------------------------
' Draw Bolls as spheres
    zi = zb + hb / 2
    dfi = 2 * Pi / 16
    For i = 0 To 16
        fi = i * dfi
        xi = xc + (rb2 + rr) * Cos(fi)
        yi = yc + (rb2 + rr) * Sin(fi)
'###############################################################
If NumCosm < 2 Then
    Set grChild = grfThis.Graphics.Add(, "TCW40SPHERE")
        grChild.Cosmetic = True
Else
    Set grChild = grfThis.Graphics.Item(iCosm)
    grChild.Vertices.Clear
    iCosm = iCosm + 1
End If
Set Vers = grChild.Vertices
'###############################################################
'        Set grChild = grfThis.Graphics.Add(, "TCW40SPHERE")
'            grChild.Cosmetic = True
        Set Ver = grChild.Vertices.Add(xi, yi, zi, False, False, False, False, False, False)
        Set Ver = grChild.Vertices.Add(xi, yi, zi + rr, False, False, False, False, False, False)
        grChild.Properties("PenColor") = QBColor(4)
        grChild.Properties("Solid") = 0
   Next i

            'Add visible child Graphics
        End If

        grfThis.RegenUnlock
        'grfThis.Application.PopVertexDefaults
        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:
        'grfThis.Application.PopVertexDefaults

        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function


Examples - Gear Regen - Gear.frm

Gear.frm

Gear Regen Example

VERSION 5.00
Begin VB.Form frmGear
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Gear with Ball Bearing"
   ClientHeight    =   5640
   ClientLeft      =   6420
   ClientTop       =   2895
   ClientWidth     =   7590
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   5640
   ScaleWidth      =   7590
   Begin VB.TextBox H4
      Height          =   288
      Left            =   6720
      TabIndex        =   23
      Top             =   4680
      Width           =   732
   End
   Begin VB.TextBox H3
      Height          =   288
      Left            =   6720
      TabIndex        =   21
      Top             =   4200
      Width           =   732
   End
   Begin VB.TextBox H2
      Height          =   288
      Left            =   6720
      TabIndex        =   19
      Top             =   3720
      Width           =   732
   End
   Begin VB.TextBox H1
      Height          =   288
      Left            =   6720
      TabIndex        =   17
      Top             =   3240
      Width           =   732
   End
   Begin VB.TextBox H0
      Height          =   288
      Left            =   6720
      TabIndex        =   15
      Top             =   2760
      Width           =   732
   End
   Begin VB.TextBox Di
      Height          =   288
      Left            =   6720
      TabIndex        =   13
      Top             =   2280
      Width           =   732
   End
   Begin VB.TextBox D2
      Height          =   288
      Left            =   6720
      TabIndex        =   11
      Top             =   1800
      Width           =   732
   End
   Begin VB.TextBox D1
      Height          =   288
      Left            =   6720
      TabIndex        =   9
      Top             =   1320
      Width           =   732
   End
   Begin VB.TextBox OutsideDiam
      Height          =   288
      Left            =   6720
      TabIndex        =   7
      Top             =   840
      Width           =   732
   End
   Begin VB.TextBox CircPitch
      Enabled         =   0   'False
      Height          =   285
      Left            =   6720
      TabIndex        =   5
      Top             =   5160
      Visible         =   0   'False
      Width           =   735
   End
   Begin VB.PictureBox Picture1
      AutoSize        =   -1  'True
      Height          =   6180
      Left            =   0
      Picture         =   "Gear.frx":0000
      ScaleHeight     =   6120
      ScaleWidth      =   5925
      TabIndex        =   4
      Top             =   120
      Width           =   5985
   End
   Begin VB.TextBox txtTeethNum
      Height          =   285
      Left            =   6720
      TabIndex        =   3
      Text            =   "40"
      Top             =   360
      Width           =   735
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   1680
      TabIndex        =   0
      Top             =   5160
      Width           =   1092
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   3360
      TabIndex        =   1
      Top             =   5160
      Width           =   1092
   End
   Begin VB.Label Label11
      Caption         =   "H4="
      Height          =   252
      Left            =   6240
      TabIndex        =   24
      Top             =   4680
      Width           =   372
   End
   Begin VB.Label Label10
      Caption         =   "H3="
      Height          =   252
      Left            =   6240
      TabIndex        =   22
      Top             =   4200
      Width           =   372
   End
   Begin VB.Label Label9
      Caption         =   "H2="
      Height          =   252
      Left            =   6240
      TabIndex        =   20
      Top             =   3720
      Width           =   372
   End
   Begin VB.Label Label8
      Caption         =   "H1="
      Height          =   252
      Left            =   6240
      TabIndex        =   18
      Top             =   3240
      Width           =   372
   End
   Begin VB.Label Label7
      Caption         =   "H="
      Height          =   252
      Left            =   6240
      TabIndex        =   16
      Top             =   2760
      Width           =   252
   End
   Begin VB.Label Label6
      Caption         =   "Di="
      Height          =   252
      Left            =   6240
      TabIndex        =   14
      Top             =   2280
      Width           =   252
   End
   Begin VB.Label Label5
      Caption         =   "D2="
      Height          =   252
      Left            =   6240
      TabIndex        =   12
      Top             =   1800
      Width           =   372
   End
   Begin VB.Label Label4
      Caption         =   "D1="
      Height          =   252
      Left            =   6240
      TabIndex        =   10
      Top             =   1320
      Width           =   372
   End
   Begin VB.Label Label3
      Caption         =   "OutsideDiameter D="
      Height          =   372
      Left            =   5040
      TabIndex        =   8
      Top             =   840
      Width           =   1572
   End
   Begin VB.Label Label2
      Caption         =   "Circular pitch="
      Height          =   252
      Left            =   5520
      TabIndex        =   6
      Top             =   5160
      Visible         =   0   'False
      Width           =   1092
   End
   Begin VB.Label Label1
      Caption         =   "Number of Teeth="
      Height          =   252
      Left            =   5280
      TabIndex        =   2
      Top             =   360
      Width           =   1332
   End
End
Attribute VB_Name = "frmGear"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
'    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Me.Hide
End Sub


Examples - 2D Nut Regen - Nut2.bas

Nut2.bas

2D Nut Regen Example

Attribute VB_Name = "Module1"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
Global Const Pi = 3.14159
Global TypeN As String
Global ViewN As String
' DLL Entry point
Sub Main()

End Sub


Examples - 2D Nut Regen - Nut2.cls

Nut2.cls

2D Nut Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Detail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2000                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idNutType = 1
Const idDiameter = 2
Const idLength = 3
Const idView = 4
Const idLengthThread = 5

'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 5
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0
Private PColor As Long
Private BColor As Long

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "Nut"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{FDB6F1C3-9631-11d1-A40A-0000B465872B}"

End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
    Names(0) = "NutType"
    Types(0) = typeString
    IDs(0) = idNutType
    Defaults(0) = "HexNut"

    Names(1) = "DiameterN"
    Types(1) = typeDouble
    IDs(1) = idDiameter
    Defaults(1) = 1#

    Names(2) = "LengthN"
    Types(2) = typeDouble
    IDs(2) = idLength
    Defaults(2) = 3#

    Names(3) = "NutView"
    Types(3) = typeString
    IDs(3) = idView
    Defaults(3) = "Front"

    Names(4) = "LengthThreadN"
    Types(4) = typeDouble
    IDs(4) = idLengthThread
    Defaults(4) = 0#

   GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmSample
    Names(0) = frmSample.Caption
    Unload frmSample

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long

End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed
        Dim i%
        Dim Diameter#, Length#, LThread#
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmSample
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next
                'When the property page is closed, transfer the numeric
                'Diameter value from the TextBox to the Graphic
                'Get the value as a double-precision number
                TypeN = .List1.Text
                ViewN = .List2.Text
                Diameter# = CDbl(.txtdd.Text)
'                Length# = CDbl(.txtLen.Text)
                LThread# = CDbl(.txtLenThread.Text)

                'Make sure it's between 0 and 100
                If Diameter# < 0# Then Diameter# = 1#
                If Diameter# > 3# Then Diameter# = 3#

                'Set the roundness property value in the Graphic
                Graphic.Properties("DiameterN") = Diameter#
'                Graphic.Properties("Length") = Length#
                Graphic.Properties("NutType") = TypeN
                Graphic.Properties("NutView") = ViewN
                Graphic.Properties("LengthThreadN") = LThread

            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmSample
            With frmSample

                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                'roundness value from the Graphic to the TextBox
                'Get the roundness property value from the Graphic
                Diameter# = Graphic.Properties("DiameterN")
'                Length# = Graphic.Properties("Length")
                TypeN = Graphic.Properties("NutType")
                ViewN = Graphic.Properties("NutView")
                LThread = Graphic.Properties("LengthThreadN")
            'Set the TextBox control's text
                .txtdd.Text = Diameter#
'                .txtLen = Length#
                .List1.Text = TypeN
                .List2.Text = ViewN
                .txtLenThread.Text = LThread
NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmSample
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmSample
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If

    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "first point of axis"
    grfThis.Vertices.Add 0#, 0, 0#, False, True, True, True, True, False

    'Second Vertex is "Second point of axis"

    grfThis.Vertices.Add 3#, 0, 0#, False, True, True, True, True, False
    grfThis.Properties("PenColor") = RGB(0, 0, 0)
    grfThis.Properties("BrushColor") = RGB(255, 255, 255)

    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis As Object)
        'Setup error handler
        On Error GoTo Failed

        'Set up lock (prevent recursion)
        Dim LockCount&
        LockCount& = grfThis.RegenLock
        PColor = grfThis.Properties("PenColor")
'        BColor = grfThis.Properties("BrushColor")
''AALB problem with load old files
' AALB try to fix bug with reading files from TC v6.5 (problem is that some sdk regens
' has Type = 7(Group, must be GRAPHIc (11))
On Error Resume Next
Err.Clear
        BColor = grfThis.Properties("BrushColor")
        If Err.Number <> 0 Then
            BColor = RGB(255, 255, 255)
            Err.Clear
        End If

        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
            grfThis.Graphics.Clear gfCosmetic

            TypeN = grfThis.Properties("NutType")
            ViewN = grfThis.Properties("NutView")

            Dim dd#
                dd = grfThis.Properties("DiameterN")

            Dim LThread#
                LThread = grfThis.Properties("LengthThreadN")
Dim X00#, Y00#, X01#, Y01#
            With grfThis.Vertices
                X00 = .Item(0).X
                Y00 = .Item(0).Y
                X01 = .Item(1).X
                Y01 = .Item(1).Y
                If Abs(X00 - X01) < 0.001 And Abs(Y00 - Y01) < 0.001 Then
                    .Item(1).X = X00 + 1#
                    .Item(1).Y = Y00
                End If
            End With
'##########################################################
            If TypeN = "HexNut" Then
                Call HexNut(grfThis, dd, LThread)
            End If

            If TypeN = "HexFlangeNut" Then
                Call HexFlangeNut(grfThis, dd, LThread)
            End If

            If TypeN = "HexSlottedNut" Then
                Call HexSlottedNut(grfThis, dd, LThread)
            End If

            If TypeN = "LowCrownNut" Then
                Call LowCrownNut(grfThis, dd, LThread)
            End If

            If TypeN = "SquareNut" Then
                Call SquareNut(grfThis, dd, LThread)
            End If

            'Add visible child Graphics
        End If

        grfThis.RegenUnlock
        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:

'        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
'        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function
Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function

Private Sub HexNut(Gr As Graphic, dd As Double, LThread As Double)
Dim D#, H#, S#, K#, del#
        D = 1.84 * dd
        H = 1# * dd
        S = D * Cos(Pi / 6)
        K = D / 2 * (1 - Cos(Pi / 6)) * Tan(Pi / 6)
        del = 0.15 * dd
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim Salp#, Calp#, L#
Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
            Salp = (Y01 - Y00) / L
            Calp = (X01 - X00) / L
        End With
        If Abs(H - L) > 0.0001 Then
            X01 = X00 + H * Calp
            Y01 = Y00 + H * Salp
            With Gr.Vertices
                .Item(1).X = X01
                .Item(1).Y = Y01
                L = H
            End With
        End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Dim x0(26)
Dim y0(26)
Dim X(26)
Dim Y(26)

       x0(1) = 0#
       y0(1) = S / 2#

       x0(2) = x0(1)
       y0(2) = -y0(1)

       x0(3) = K
       y0(3) = D / 2#

       x0(4) = x0(3)
       y0(4) = -y0(3)

       x0(5) = H - K
       y0(5) = D / 2

       x0(6) = x0(5)
       y0(6) = -y0(5)

       x0(7) = H
       y0(7) = S / 2#

       x0(8) = x0(7)
       y0(8) = -y0(7)

       x0(9) = x0(3)
       y0(9) = D / 4

       x0(10) = x0(9)
       y0(10) = -y0(9)

       x0(11) = x0(5)
       y0(11) = D / 4#

       x0(12) = x0(11)
       y0(12) = -y0(11)

       x0(13) = 0#
       y0(13) = 3 * D / 8

       x0(14) = x0(13)
       y0(14) = -y0(13)

       x0(15) = H
       y0(15) = 3 * D / 8

       x0(16) = x0(15)
       y0(16) = -y0(15)

       x0(17) = 0
       y0(17) = 0

       x0(18) = H
       y0(18) = 0#

' Thread
       x0(19) = H
       y0(19) = dd / 2

       x0(20) = x0(19)
       y0(20) = -y0(19)

       x0(21) = H + LThread - del
       y0(21) = dd / 2

       x0(22) = x0(21)
       y0(22) = -y0(21)

       x0(23) = H + LThread
       y0(23) = dd / 2 - del

       x0(24) = x0(23)
       y0(24) = -y0(23)

       x0(25) = H
       y0(25) = dd / 2 - del

       x0(26) = x0(25)
       y0(26) = -y0(25)

Dim i%
       For i = 1 To 26
          X(i) = X00 + x0(i) * Calp - y0(i) * Salp
          Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
        If ViewN = "Front" Then
            If LThread > 0.01 * dd Then
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(19), Y(19), 0, True, True, False, False, False, False
                    .Add X(21), Y(21), 0, True, True, False, False, False, False
                    .Add X(23), Y(23), 0, True, True, False, False, False, False
                    .Add X(24), Y(24), 0, True, True, False, False, False, False
                    .Add X(22), Y(22), 0, True, True, False, False, False, False
                    .Add X(20), Y(20), 0, True, True, False, False, False, False
                    .Add X(19), Y(19), 0, True, True, False, False, False, False
                End With
                GrChild.Closed = True
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                GrChild.Properties("BrushStyle") = "Solid"
'                GrChild.Properties("BrushColor") = RGB(255, 255, 255)
                GrChild.Properties("BrushColor") = BColor
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(19), Y(19), 0, True, True, False, False, False, False
                    .Add X(20), Y(20), 0, True, True, False, False, False, False
                    .Add X(21), Y(21), 0, False, True, False, False, False, False
                    .Add X(22), Y(22), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(25), Y(25), 0, True, True, False, False, False, False
                    .Add X(23), Y(23), 0, True, True, False, False, False, False
                    .Add X(26), Y(26), 0, False, True, False, False, False, False
                    .Add X(24), Y(24), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenColor") = PColor
            End If
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                    GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
            End With
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
             Set GrChild = Gr.Graphics.Add(gkGraphic)
                       GrChild.Cosmetic = True
             With GrChild.Vertices
                 .Add X(9), Y(9), 0, True, True, False, False, False, False
                 .Add X(11), Y(11), 0, True, True, False, False, False, False
                 .Add X(10), Y(10), 0, False, True, False, False, False, False
                 .Add X(12), Y(12), 0, True, True, False, False, False, False
             End With
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '14
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(3), Y(3), 0#, X(13), Y(13), 0#, X(9), Y(9), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '15
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(9), Y(9), 0#, X(17), Y(17), 0#, X(10), Y(10), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '16
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, X(14), Y(14), 0#, X(4), Y(4), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

            '14
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(5), Y(5), 0#, X(15), Y(15), 0#, X(11), Y(11), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
             GrChild.Properties("PenColor") = PColor
           '15
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(11), Y(11), 0#, X(18), Y(18), 0#, X(12), Y(12), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '16
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(12), Y(12), 0#, X(16), Y(16), 0#, X(6), Y(6), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
        End If
'-------------------------------------------------------------
        If ViewN = "Top" Then
' View Top
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                For i = 0 To 6
                    x0(i) = D / 2 * Cos(Pi / 3 * i)
                    y0(i) = D / 2 * Sin(Pi / 3 * i)
                    X(i) = X00 + x0(i) * Calp - y0(i) * Salp
                    Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
                   .Add X(i), Y(i), 0, True, True, False, False, False, False
                Next i
            End With
             GrChild.Closed = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             GrChild.Properties("BrushStyle") = "Solid"
'             GrChild.Properties("BrushColor") = RGB(255, 255, 255)
             GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + D / 2 * Sin(Pi / 3), Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
             GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2 - del, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            x0(7) = D / 2
            y0(7) = 0
            X(7) = X00 + x0(7) * Calp - y0(7) * Salp
            Y(7) = Y00 + x0(7) * Salp + y0(7) * Calp

           With Gr.Vertices
                .Item(1).X = X(7)
                .Item(1).Y = Y(7)
            End With
        End If
End Sub

Private Sub LowCrownNut(Gr As Graphic, dd As Double, LThread As Double)
Dim D#, H#, S#, K#
        D = 1.63 * dd
        H = 0.72 * dd
        S = D * Cos(Pi / 6)
        K = D / 2 * (1 - Cos(Pi / 6)) * Tan(Pi / 6)
Dim Q#
        Q = 1.55 * dd '1.55
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim Salp#, Calp#, L#
Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
            Salp = (Y01 - Y00) / L
            Calp = (X01 - X00) / L
        End With
        If Abs(H - L) > 0.0001 Then
            X01 = X00 + H * Calp
            Y01 = Y00 + H * Salp
            With Gr.Vertices
                .Item(1).X = X01
                .Item(1).Y = Y01
                L = H
            End With
        End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Dim x0(19)
Dim y0(19)
Dim X(19)
Dim Y(19)

       x0(1) = 0#
       y0(1) = S / 2#

       x0(2) = x0(1)
       y0(2) = -y0(1)

       x0(3) = K
       y0(3) = D / 2#

       x0(4) = x0(3)
       y0(4) = -y0(3)

       x0(5) = H - K
       y0(5) = D / 2

       x0(6) = x0(5)
       y0(6) = -y0(5)

       x0(7) = H
       y0(7) = S / 2#

       x0(8) = x0(7)
       y0(8) = -y0(7)

       x0(9) = x0(3)
       y0(9) = D / 4

       x0(10) = x0(9)
       y0(10) = -y0(9)

       x0(11) = x0(5)
       y0(11) = D / 4#

       x0(12) = x0(11)
       y0(12) = -y0(11)

       x0(13) = 0#
       y0(13) = 3 * D / 8

       x0(14) = x0(13)
       y0(14) = -y0(13)

       x0(15) = H
       y0(15) = 3 * D / 8

       x0(16) = x0(15)
       y0(16) = -y0(15)

       x0(17) = 0
       y0(17) = 0

       x0(18) = H
       y0(18) = 0#

       x0(19) = Q
       y0(19) = 0#

Dim i%
       For i = 1 To 19
          X(i) = X00 + x0(i) * Calp - y0(i) * Salp
          Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
        If ViewN = "Front" Then
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
            End With
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(9), Y(9), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, False, True, False, False, False, False
                .Add X(12), Y(12), 0, True, False, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(3), Y(3), 0#, X(13), Y(13), 0#, X(9), Y(9), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(9), Y(9), 0#, X(17), Y(17), 0#, X(10), Y(10), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '16
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, X(14), Y(14), 0#, X(4), Y(4), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(5), Y(5), 0#, X(15), Y(15), 0#, X(11), Y(11), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(11), Y(11), 0#, X(18), Y(18), 0#, X(12), Y(12), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '16
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(12), Y(12), 0#, X(16), Y(16), 0#, X(6), Y(6), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
    'Elliptical Arc
           Set GrChild = Gr.Graphics.AddArcRotatedElliptical((X(7) + X(8)) / 2, (Y(7) + Y(8)) / 2, 0#, X(19), Y(19), 0#, X(7), Y(7), 0#, -Pi / 2, Pi / 2)
                      GrChild.Cosmetic = True
Dim GrHatch As Graphic
           Set GrHatch = GrChild.Graphics.AddHatch
                      GrHatch.Cosmetic = True
            GrHatch.Properties("BrushStyle") = "Solid"
'            GrHatch.Properties("BrushColor") = RGB(255, 255, 255)
            GrHatch.Properties("BrushColor") = BColor
            GrChild.Deleted = True
           Set GrChild = Gr.Graphics.AddArcRotatedElliptical((X(7) + X(8)) / 2, (Y(7) + Y(8)) / 2, 0#, X(19), Y(19), 0#, X(7), Y(7), 0#, -Pi / 2, Pi / 2)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

        End If

'-------------------------------------------------------------
' View Top
        If ViewN = "Top" Then
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                For i = 0 To 6
                    x0(i) = D / 2 * Cos(Pi / 3 * i)
                    y0(i) = D / 2 * Sin(Pi / 3 * i)
                    X(i) = X00 + x0(i) * Calp - y0(i) * Salp
                    Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
                   .Add X(i), Y(i), 0, True, True, False, False, False, False
                Next i
            End With
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             GrChild.Properties("BrushStyle") = "Solid"
'             GrChild.Properties("BrushColor") = RGB(255, 255, 255)
             GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + D / 2 * Sin(Pi / 3), Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            x0(7) = D / 2
            y0(7) = 0
            X(7) = X00 + x0(7) * Calp - y0(7) * Salp
            Y(7) = Y00 + x0(7) * Salp + y0(7) * Calp

           With Gr.Vertices
                .Item(1).X = X(7)
                .Item(1).Y = Y(7)
            End With
        End If
End Sub

Private Sub SquareNut(Gr As Graphic, dd As Double, LThread As Double)
Dim D#, H#, S#, K#, del#
        D = 2# * dd
        H = 0.9 * dd
        S = D * Cos(Pi / 4)
        K = 0.5 * (D - S) * Tan(Pi / 6)
        del = 0.15 * dd
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim Salp#, Calp#, L#
Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
            Salp = (Y01 - Y00) / L
            Calp = (X01 - X00) / L
        End With
        If Abs(H - L) > 0.0001 Then
            X01 = X00 + H * Calp
            Y01 = Y00 + H * Salp
            With Gr.Vertices
                .Item(1).X = X01
                .Item(1).Y = Y01
                L = H
            End With
        End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Dim x0(22)
Dim y0(22)
Dim X(22)
Dim Y(22)

       x0(1) = 0#
       y0(1) = S / 2#

       x0(2) = x0(1)
       y0(2) = -y0(1)

       x0(3) = K
       y0(3) = D / 2#

       x0(4) = x0(3)
       y0(4) = -y0(3)

       x0(5) = H - K
       y0(5) = D / 2

       x0(6) = x0(5)
       y0(6) = -y0(5)

       x0(7) = H
       y0(7) = S / 2#

       x0(8) = x0(7)
       y0(8) = -y0(7)

       x0(9) = x0(3)
       y0(9) = 0#

       x0(10) = x0(5)
       y0(10) = 0#

       x0(11) = 0
       y0(11) = D / 4#

       x0(12) = x0(11)
       y0(12) = -y0(11)

       x0(13) = H
       y0(13) = D / 4

       x0(14) = x0(13)
       y0(14) = -y0(13)

' Thread
       x0(15) = H
       y0(15) = dd / 2

       x0(16) = x0(15)
       y0(16) = -y0(15)

       x0(17) = H + LThread - del
       y0(17) = dd / 2

       x0(18) = x0(17)
       y0(18) = -y0(17)

       x0(19) = H + LThread
       y0(19) = dd / 2 - del

       x0(20) = x0(19)
       y0(20) = -y0(19)

       x0(21) = H
       y0(21) = dd / 2 - del

       x0(22) = x0(21)
       y0(22) = -y0(21)

Dim i%
       For i = 1 To 22
          X(i) = X00 + x0(i) * Calp - y0(i) * Salp
          Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
        If ViewN = "Front" Then
            If LThread > 0.01 * dd Then
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(15), Y(15), 0, True, True, False, False, False, False
                    .Add X(17), Y(17), 0, True, True, False, False, False, False
                    .Add X(19), Y(19), 0, True, True, False, False, False, False
                    .Add X(20), Y(20), 0, True, True, False, False, False, False
                    .Add X(18), Y(18), 0, True, True, False, False, False, False
                    .Add X(16), Y(16), 0, True, True, False, False, False, False
                    .Add X(15), Y(15), 0, True, True, False, False, False, False
                End With
                GrChild.Closed = True
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                GrChild.Properties("BrushStyle") = "Solid"
'                GrChild.Properties("BrushColor") = RGB(255, 255, 255)
                GrChild.Properties("BrushColor") = BColor
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(17), Y(17), 0, False, True, False, False, False, False
                    .Add X(18), Y(18), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(21), Y(21), 0, True, True, False, False, False, False
                    .Add X(19), Y(19), 0, True, True, False, False, False, False
                    .Add X(22), Y(22), 0, False, True, False, False, False, False
                    .Add X(20), Y(20), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenColor") = PColor
            End If
             Set GrChild = Gr.Graphics.Add(gkGraphic)
                       GrChild.Cosmetic = True
             With GrChild.Vertices
                 .Add X(1), Y(1), 0, True, True, False, False, False, False
                 .Add X(3), Y(3), 0, True, True, False, False, False, False
                 .Add X(5), Y(5), 0, True, True, False, False, False, False
                 .Add X(7), Y(7), 0, True, True, False, False, False, False
                 .Add X(8), Y(8), 0, True, True, False, False, False, False
                 .Add X(6), Y(6), 0, True, True, False, False, False, False
                 .Add X(4), Y(4), 0, True, True, False, False, False, False
                 .Add X(2), Y(2), 0, True, True, False, False, False, False
                 .Add X(1), Y(1), 0, True, True, False, False, False, False
             End With
             GrChild.Closed = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'             GrChild.Properties("BrushColor") = RGB(255, 255, 255)
             GrChild.Properties("BrushColor") = BColor
             Set GrChild = Gr.Graphics.Add(gkGraphic)
                       GrChild.Cosmetic = True
             With GrChild.Vertices
                 .Add X(9), Y(9), 0, True, True, False, False, False, False
                 .Add X(10), Y(10), 0, True, True, False, False, False, False
             End With
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '14
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(3), Y(3), 0#, X(11), Y(11), 0#, X(9), Y(9), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '15
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(9), Y(9), 0#, X(12), Y(12), 0#, X(4), Y(4), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '16
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(5), Y(5), 0#, X(13), Y(13), 0#, X(10), Y(10), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

            '14
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, X(14), Y(14), 0#, X(6), Y(6), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '15
        End If
 '-------------------------------------------------------------
        If ViewN = "Top" Then
' View Top
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                For i = 0 To 4
                    x0(i) = D / 2 * Cos(Pi / 2 * i)
                    y0(i) = D / 2 * Sin(Pi / 2 * i)
                    X(i) = X00 + x0(i) * Calp - y0(i) * Salp
                    Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
                   .Add X(i), Y(i), 0, True, True, False, False, False, False
                Next i
            End With
             GrChild.Closed = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             GrChild.Properties("BrushStyle") = "Solid"
'             GrChild.Properties("BrushColor") = RGB(255, 255, 255)
             GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + D / 2 * Sin(Pi / 4), Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2 - del, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            x0(5) = D / 2
            y0(5) = 0
            X(5) = X00 + x0(5) * Calp - y0(5) * Salp
            Y(5) = Y00 + x0(5) * Salp + y0(5) * Calp

           With Gr.Vertices
                .Item(1).X = X(5)
                .Item(1).Y = Y(5)
            End With
        End If
End Sub

Private Sub HexFlangeNut(Gr As Graphic, dd As Double, LThread As Double)
Dim D#, Dw#, C#, K#, K1#, E#, Di#, del#
        D = 1.7 * dd
        Dw = 1.96 * dd
        C = 0.15 * dd
        K = 1# * dd
        K1 = 0.43 * dd
        E = (K - K1) * 0.85
        Di = D * Sin(Pi / 3#)
        del = 0.15 * dd
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim Salp#, Calp#, L#
Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
            Salp = (Y01 - Y00) / L
            Calp = (X01 - X00) / L
        End With
        If Abs(K - L) > 0.0001 Then
            X01 = X00 + K * Calp
            Y01 = Y00 + K * Salp
            With Gr.Vertices
                .Item(1).X = X01
                .Item(1).Y = Y01
                L = K
            End With
        End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Dim x0(25)
Dim y0(25)
Dim X(25)
Dim Y(25)

       x0(1) = 0#
       y0(1) = Dw / 2#

       x0(2) = x0(1)
       y0(2) = -y0(1)

       x0(3) = C
       y0(3) = Dw / 2#

       x0(4) = x0(3)
       y0(4) = -y0(3)

       x0(5) = K1
       y0(5) = D / 2

       x0(6) = x0(5)
       y0(6) = -y0(5)

       x0(7) = K1 + E
       y0(7) = D / 2#

       x0(8) = x0(7)
       y0(8) = -y0(7)

       x0(9) = K
       y0(9) = Di / 2

       x0(10) = x0(9)
       y0(10) = -y0(9)

       x0(11) = K1
       y0(11) = D / 4#

       x0(12) = x0(11)
       y0(12) = -y0(11)

       x0(13) = x0(7)
       y0(13) = y0(11)

       x0(14) = x0(13)
       y0(14) = -y0(13)

       x0(15) = K
       y0(15) = 3# * D / 8#

       x0(16) = x0(15)
       y0(16) = -y0(15)

       x0(17) = K
       y0(17) = 0#

' Thread
       x0(18) = K
       y0(18) = dd / 2

       x0(19) = x0(18)
       y0(19) = -y0(18)

       x0(20) = K + LThread - del
       y0(20) = dd / 2

       x0(21) = x0(20)
       y0(21) = -y0(20)

       x0(22) = K + LThread
       y0(22) = dd / 2 - del

       x0(23) = x0(22)
       y0(23) = -y0(22)

       x0(24) = K
       y0(24) = dd / 2 - del

       x0(25) = x0(24)
       y0(25) = -y0(24)

Dim i%
       For i = 1 To 25
          X(i) = X00 + x0(i) * Calp - y0(i) * Salp
          Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
        If ViewN = "Front" Then
            If LThread > 0.01 * dd Then
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(18), Y(18), 0, True, True, False, False, False, False
                    .Add X(20), Y(20), 0, True, True, False, False, False, False
                    .Add X(22), Y(22), 0, True, True, False, False, False, False
                    .Add X(23), Y(23), 0, True, True, False, False, False, False
                    .Add X(21), Y(21), 0, True, True, False, False, False, False
                    .Add X(19), Y(19), 0, True, True, False, False, False, False
                    .Add X(18), Y(18), 0, True, True, False, False, False, False
                End With
                GrChild.Closed = True
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                GrChild.Properties("BrushStyle") = "Solid"
'                GrChild.Properties("BrushColor") = RGB(255, 255, 255)
                GrChild.Properties("BrushColor") = BColor
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(20), Y(20), 0, False, True, False, False, False, False
                    .Add X(21), Y(21), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(24), Y(24), 0, True, True, False, False, False, False
                    .Add X(22), Y(22), 0, True, True, False, False, False, False
                    .Add X(25), Y(25), 0, False, True, False, False, False, False
                    .Add X(23), Y(23), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenColor") = PColor
            End If
             Set GrChild = Gr.Graphics.Add(gkGraphic)
                       GrChild.Cosmetic = True
             With GrChild.Vertices
                 .Add X(1), Y(1), 0, True, True, False, False, False, False
                 .Add X(3), Y(3), 0, True, True, False, False, False, False
                 .Add X(5), Y(5), 0, True, True, False, False, False, False
                 .Add X(7), Y(7), 0, True, True, False, False, False, False
                 .Add X(9), Y(9), 0, True, True, False, False, False, False
                 .Add X(10), Y(10), 0, True, True, False, False, False, False
                 .Add X(8), Y(8), 0, True, True, False, False, False, False
                 .Add X(6), Y(6), 0, True, True, False, False, False, False
                 .Add X(4), Y(4), 0, True, True, False, False, False, False
                 .Add X(2), Y(2), 0, True, True, False, False, False, False
                 .Add X(1), Y(1), 0, True, True, False, False, False, False
             End With
             GrChild.Closed = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             GrChild.Properties("BrushStyle") = "Solid"
'             GrChild.Properties("BrushColor") = RGB(255, 255, 255)
             GrChild.Properties("BrushColor") = BColor
             Set GrChild = Gr.Graphics.Add(gkGraphic)
                       GrChild.Cosmetic = True
             With GrChild.Vertices
                 .Add X(3), Y(3), 0, True, True, False, False, False, False
                 .Add X(4), Y(4), 0, True, True, False, False, False, False
                 .Add X(5), Y(5), 0, False, True, False, False, False, False
                 .Add X(6), Y(6), 0, True, True, False, False, False, False
                 .Add X(11), Y(11), 0, False, True, False, False, False, False
                 .Add X(13), Y(13), 0, True, True, False, False, False, False
                 .Add X(12), Y(12), 0, False, True, False, False, False, False
                 .Add X(14), Y(14), 0, True, True, False, False, False, False
             End With
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '14
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(7), Y(7), 0#, X(15), Y(15), 0#, X(13), Y(13), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '15
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(8), Y(8), 0#, X(16), Y(16), 0#, X(14), Y(14), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            '16
            Set GrChild = Gr.Graphics.AddArcTriplePoint(X(13), Y(13), 0#, X(17), Y(17), 0#, X(14), Y(14), 0#)
                       GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
        End If
'-------------------------------------------------------------
' View Top
        If ViewN = "Top" Then
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + Dw / 2, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             GrChild.Properties("BrushStyle") = "Solid"
'             GrChild.Properties("BrushColor") = RGB(255, 255, 255)
             GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                For i = 0 To 6
                    x0(i) = D / 2 * Cos(Pi / 3 * i)
                    y0(i) = D / 2 * Sin(Pi / 3 * i)
                    X(i) = X00 + x0(i) * Calp - y0(i) * Salp
                    Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
                   .Add X(i), Y(i), 0, True, True, False, False, False, False
                Next i
            End With
             GrChild.Closed = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + D / 2 * Sin(Pi / 3), Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2 - del, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            x0(7) = D / 2
            y0(7) = 0
            X(7) = X00 + x0(7) * Calp - y0(7) * Salp
            Y(7) = Y00 + x0(7) * Salp + y0(7) * Calp

           With Gr.Vertices
                .Item(1).X = X(7)
                .Item(1).Y = Y(7)
            End With
        End If
End Sub

Private Sub HexSlottedNut(Gr As Graphic, dd As Double, LThread As Double)
Dim D#, H#, S#, K#, J#, H1#, del#
        D = 1.84 * dd
        H = 1# * dd
        S = D * Cos(Pi / 6)
        K = D / 2 * (1 - Cos(Pi / 6)) * Tan(Pi / 6)
        J = 0.3 * dd
        H1 = 0.3 * dd
        del = 0.15 * dd
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim Salp#, Calp#, L#
Dim X00#, Y00#, X01#, Y01#
        With Gr.Vertices
            X00 = .Item(0).X
            Y00 = .Item(0).Y
            X01 = .Item(1).X
            Y01 = .Item(1).Y
            L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
            Salp = (Y01 - Y00) / L
            Calp = (X01 - X00) / L
        End With
        If Abs(H - L) > 0.0001 Then
            X01 = X00 + H * Calp
            Y01 = Y00 + H * Salp
            With Gr.Vertices
                .Item(1).X = X01
                .Item(1).Y = Y01
                L = H
            End With
        End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Dim x0(41)
Dim y0(41)
Dim X(41)
Dim Y(41)

       x0(1) = 0#
       y0(1) = S / 2#

       x0(2) = x0(1)
       y0(2) = -y0(1)

       x0(3) = K
       y0(3) = D / 2#

       x0(4) = x0(3)
       y0(4) = -y0(3)

       x0(5) = H - K
       y0(5) = D / 2

       x0(6) = x0(5)
       y0(6) = -y0(5)

       x0(7) = H
       y0(7) = S / 2#

       x0(8) = x0(7)
       y0(8) = -y0(7)

       x0(9) = x0(3)
       y0(9) = D / 4

       x0(10) = x0(9)
       y0(10) = -y0(9)

       x0(11) = x0(5)
       y0(11) = D / 4#

       x0(12) = x0(11)
       y0(12) = -y0(11)

       x0(13) = 0#
       y0(13) = 3 * D / 8

       x0(14) = x0(13)
       y0(14) = -y0(13)

       x0(15) = H
       y0(15) = 3 * D / 8

       x0(16) = x0(15)
       y0(16) = -y0(15)

       x0(17) = 0
       y0(17) = 0

       x0(18) = H
       y0(18) = 0#
'#########################################################
       x0(19) = H
       y0(19) = y0(15) + J / 4
       x0(20) = H
       y0(20) = y0(15) - J / 4

       x0(21) = H - H1
       y0(21) = y0(19)
       x0(22) = x0(21)
       y0(22) = y0(20)

       x0(23) = H - H1 - J / 4
       y0(23) = y0(15)
'--------------------------------------------------------
       x0(24) = H
       y0(24) = y0(16) + J / 4
       x0(25) = H
       y0(25) = y0(16) - J / 4

       x0(26) = H - H1
       y0(26) = y0(24)
       x0(27) = x0(26)
       y0(27) = y0(25)

       x0(28) = x0(23)
       y0(28) = y0(16)

'--------------------------------------------------------
       x0(29) = H
       y0(29) = J / 2
       x0(30) = H
       y0(30) = -J / 2

       x0(31) = x0(21) + J / 4
       y0(31) = y0(29)
       x0(32) = x0(21) + J / 4
       y0(32) = y0(30)

       x0(33) = x0(23)
       y0(33) = 0#

' Thread
       x0(34) = H
       y0(34) = dd / 2

       x0(35) = x0(34)
       y0(35) = -y0(34)

       x0(36) = H + LThread - del
       y0(36) = dd / 2

       x0(37) = x0(36)
       y0(37) = -y0(36)

       x0(38) = H + LThread
       y0(38) = dd / 2 - del

       x0(39) = x0(38)
       y0(39) = -y0(38)

       x0(40) = H
       y0(40) = dd / 2 - del

       x0(41) = x0(40)
       y0(41) = -y0(40)

Dim i%
       For i = 1 To 41
          X(i) = X00 + x0(i) * Calp - y0(i) * Salp
          Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
       Next i
Dim GrChild As Graphic
            'Add child Graphics
        If ViewN = "Front" Then
            If LThread > 0.01 * dd Then
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(34), Y(34), 0, True, True, False, False, False, False
                    .Add X(36), Y(36), 0, True, True, False, False, False, False
                    .Add X(38), Y(38), 0, True, True, False, False, False, False
                    .Add X(39), Y(39), 0, True, True, False, False, False, False
                    .Add X(37), Y(37), 0, True, True, False, False, False, False
                    .Add X(35), Y(35), 0, True, True, False, False, False, False
                    .Add X(34), Y(34), 0, True, True, False, False, False, False
                End With
                GrChild.Closed = True
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                GrChild.Properties("BrushStyle") = "Solid"
                 GrChild.Properties("BrushColor") = BColor
               Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(36), Y(36), 0, False, True, False, False, False, False
                    .Add X(37), Y(37), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add X(40), Y(40), 0, True, True, False, False, False, False
                    .Add X(38), Y(38), 0, True, True, False, False, False, False
                    .Add X(41), Y(41), 0, False, True, False, False, False, False
                    .Add X(39), Y(39), 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenColor") = PColor
            End If
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(1), Y(1), 0, True, True, False, False, False, False
                .Add X(3), Y(3), 0, True, True, False, False, False, False
                .Add X(5), Y(5), 0, True, True, False, False, False, False
                .Add X(7), Y(7), 0, True, True, False, False, False, False
                .Add X(8), Y(8), 0, True, True, False, False, False, False
                .Add X(6), Y(6), 0, True, True, False, False, False, False
                .Add X(4), Y(4), 0, True, True, False, False, False, False
                .Add X(2), Y(2), 0, True, True, False, False, False, False
                .Add X(1), Y(1), 0, True, True, False, False, False, False
            End With
            GrChild.Closed = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("BrushStyle") = "Solid"
'            GrChild.Properties("BrushColor") = RGB(255, 255, 255)
            GrChild.Properties("BrushColor") = BColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add X(9), Y(9), 0, True, True, False, False, False, False
                .Add X(11), Y(11), 0, True, True, False, False, False, False
                .Add X(10), Y(10), 0, False, True, False, False, False, False
                .Add X(12), Y(12), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(3), Y(3), 0#, X(13), Y(13), 0#, X(9), Y(9), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(9), Y(9), 0#, X(17), Y(17), 0#, X(10), Y(10), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '16
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(10), Y(10), 0#, X(14), Y(14), 0#, X(4), Y(4), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor

           '14
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(5), Y(5), 0#, X(15), Y(15), 0#, X(11), Y(11), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '15
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(11), Y(11), 0#, X(18), Y(18), 0#, X(12), Y(12), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           '16
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(12), Y(12), 0#, X(16), Y(16), 0#, X(6), Y(6), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
             With GrChild.Vertices
                .Add X(19), Y(19), 0, True, True, False, False, False, False
                .Add X(21), Y(21), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenColor") = PColor
            GrChild.Properties("PenWidth") = 0.02
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
             With GrChild.Vertices
                .Add X(20), Y(20), 0, True, True, False, False, False, False
                .Add X(22), Y(22), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(21), Y(21), 0#, X(23), Y(23), 0#, X(22), Y(22), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
             With GrChild.Vertices
                .Add X(24), Y(24), 0, True, True, False, False, False, False
                .Add X(26), Y(26), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
             With GrChild.Vertices
                .Add X(25), Y(25), 0, True, True, False, False, False, False
                .Add X(27), Y(27), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(26), Y(26), 0#, X(28), Y(28), 0#, X(27), Y(27), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
    '-------------------------------------------------------------
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
             With GrChild.Vertices
                .Add X(29), Y(29), 0, True, True, False, False, False, False
                .Add X(31), Y(31), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
             With GrChild.Vertices
                .Add X(30), Y(30), 0, True, True, False, False, False, False
                .Add X(32), Y(32), 0, True, True, False, False, False, False
            End With
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
           Set GrChild = Gr.Graphics.AddArcTriplePoint(X(31), Y(31), 0#, X(33), Y(33), 0#, X(32), Y(32), 0#)
                      GrChild.Cosmetic = True
            GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
        End If

        If ViewN = "Top" Then
' View Top
            Set GrChild = Gr.Graphics.Add(gkGraphic)
                      GrChild.Cosmetic = True
            With GrChild.Vertices
                For i = 0 To 6
                    x0(i) = D / 2 * Cos(Pi / 3 * i)
                    y0(i) = D / 2 * Sin(Pi / 3 * i)
                    X(i) = X00 + x0(i) * Calp - y0(i) * Salp
                    Y(i) = Y00 + x0(i) * Salp + y0(i) * Calp
                   .Add X(i), Y(i), 0, True, True, False, False, False, False
                Next i
            End With
             GrChild.Closed = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
             GrChild.Properties("BrushStyle") = "Solid"
'             GrChild.Properties("BrushColor") = RGB(255, 255, 255)
             GrChild.Properties("BrushColor") = BColor
             Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X00, Y00, 0, X00 + dd / 2 - del, Y00, 0)
                      GrChild.Cosmetic = True
             GrChild.Properties("PenWidth") = 0.02
            GrChild.Properties("PenColor") = PColor
            x0(7) = D / 2
            y0(7) = 0
            X(7) = X00 + x0(7) * Calp - y0(7) * Salp
            Y(7) = Y00 + x0(7) * Salp + y0(7) * Calp

           With Gr.Vertices
                .Item(1).X = X(7)
                .Item(1).Y = Y(7)
            End With
Dim x1#, y1#, x2#, y2#, x3#, y3#, x4#, y4#, x5#, y5#, x6#, y6#, x7#, y7#
            x1 = D / 2
            y1 = 0#
            x2 = x1 - D / 4 * Sin(Pi / 6)
            y2 = y1 + D / 4 * Sin(Pi / 3)
            x4 = x2 + J / 2 * Sin(Pi / 6)
            y4 = y2 - J / 2 * Sin(Pi / 3)
            x5 = x2 - J / 2 * Sin(Pi / 6)
            y5 = y2 + J / 2 * Sin(Pi / 3)
Dim L1#, hx#

            L1 = Sqr((x4 - x5) * (x4 - x5) + (y4 - y5) * (y4 - y5))
            hx = Sqr(dd * dd / 4 - L1 * L1 / 4)
            x3 = x2 - (D / 2 * Sin(Pi / 3) - hx) * Sin(Pi / 3)
            y3 = y2 - (D / 2 * Sin(Pi / 3) - hx) * Sin(Pi / 6)
            x6 = x3 + J / 2 * Sin(Pi / 6)
            y6 = y3 - J / 2 * Sin(Pi / 3)
            x7 = x3 - J / 2 * Sin(Pi / 6)
            y7 = y3 + J / 2 * Sin(Pi / 3)
Dim x41#, y41#, x51#, y51#, x61#, y61#, x71#, y71#
Dim x42#, y42#, x52#, y52#, x62#, y62#, x72#, y72#
Dim xc#, yc#, xc1#, yc1#, xc2#, yc2#, xc3#, yc3#
            For i = 0 To 5
                x41 = x4 * Cos(Pi / 3 * i) - y4 * Sin(Pi / 3 * i)
                y41 = x4 * Sin(Pi / 3 * i) + y4 * Cos(Pi / 3 * i)
                x51 = x5 * Cos(Pi / 3 * i) - y5 * Sin(Pi / 3 * i)
                y51 = x5 * Sin(Pi / 3 * i) + y5 * Cos(Pi / 3 * i)
                x61 = x6 * Cos(Pi / 3 * i) - y6 * Sin(Pi / 3 * i)
                y61 = x6 * Sin(Pi / 3 * i) + y6 * Cos(Pi / 3 * i)
                x71 = x7 * Cos(Pi / 3 * i) - y7 * Sin(Pi / 3 * i)
                y71 = x7 * Sin(Pi / 3 * i) + y7 * Cos(Pi / 3 * i)
                x42 = X00 + x41 * Calp - y41 * Salp
                y42 = Y00 + x41 * Salp + y41 * Calp
                x52 = X00 + x51 * Calp - y51 * Salp
                y52 = Y00 + x51 * Salp + y51 * Calp
                x62 = X00 + x61 * Calp - y61 * Salp
                y62 = Y00 + x61 * Salp + y61 * Calp
                x72 = X00 + x71 * Calp - y71 * Salp
                y72 = Y00 + x71 * Salp + y71 * Calp
                Set GrChild = Gr.Graphics.Add(gkGraphic)
                          GrChild.Cosmetic = True
                With GrChild.Vertices
                   .Add x42, y42, 0, True, True, False, False, False, False
                   .Add x62, y62, 0, True, True, False, False, False, False
                   .Add x52, y52, 0, False, True, False, False, False, False
                   .Add x72, y72, 0, True, True, False, False, False, False
                End With
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
               xc1 = x42
                yc1 = y42
                xc = D / 2 * Sin(Pi / 3) * Cos(Pi / 3 * i)
                yc = D / 2 * Sin(Pi / 3) * Sin(Pi / 3 * i)
                xc2 = X00 + xc * Calp - yc * Salp
                yc2 = Y00 + xc * Salp + yc * Calp
                x41 = x4 * Cos(Pi / 3 * i) + y4 * Sin(Pi / 3 * i)
                y41 = x4 * Sin(Pi / 3 * i) - y4 * Cos(Pi / 3 * i)
                xc3 = X00 + x41 * Calp - y41 * Salp
                yc3 = Y00 + x41 * Salp + y41 * Calp
                Set GrChild = Gr.Graphics.AddArcTriplePoint(xc1, yc1, 0, xc2, yc2, 0, xc3, yc3, 0)
                          GrChild.Cosmetic = True
                GrChild.Properties("PenWidth") = 0.02
                GrChild.Properties("PenColor") = PColor
            Next i
        End If
End Sub


Examples - 2D Nut Regen - Nut2.frm

Nut2.frm

2D Nut Regen Example

VERSION 5.00
Begin VB.Form frmSample
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Nuts"
   ClientHeight    =   3885
   ClientLeft      =   6420
   ClientTop       =   2910
   ClientWidth     =   5460
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   259
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   364
   StartUpPosition =   1  'CenterOwner
   Begin VB.TextBox txtLenThread
      Height          =   288
      Left            =   1680
      TabIndex        =   6
      Top             =   2847
      Width           =   855
   End
   Begin VB.ListBox List2
      Height          =   255
      ItemData        =   "Nut2.frx":0000
      Left            =   3960
      List            =   "Nut2.frx":000A
      TabIndex        =   5
      Top             =   120
      Width           =   1335
   End
   Begin VB.ListBox List1
      Height          =   1620
      ItemData        =   "Nut2.frx":001A
      Left            =   240
      List            =   "Nut2.frx":002D
      TabIndex        =   4
      Top             =   480
      Width           =   2295
   End
   Begin VB.TextBox txtdd
      Height          =   285
      Left            =   1680
      TabIndex        =   3
      Top             =   2400
      Width           =   855
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   4080
      TabIndex        =   0
      Top             =   3360
      Width           =   1212
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   2640
      TabIndex        =   1
      Top             =   3360
      Width           =   1215
   End
   Begin VB.Image PicPreview
      BorderStyle     =   1  'Fixed Single
      Height          =   2640
      Left            =   2700
      Stretch         =   -1  'True
      Top             =   465
      Width           =   2595
   End
   Begin VB.Label Label2
      Caption         =   "Nut Type :"
      Height          =   255
      Left            =   240
      TabIndex        =   8
      Top             =   120
      Width           =   1335
   End
   Begin VB.Label Label5
      Alignment       =   1  'Right Justify
      Caption         =   "Thread Lenght (Lt) :"
      Height          =   255
      Left            =   120
      TabIndex        =   7
      Top             =   2880
      Width           =   1455
      WordWrap        =   -1  'True
   End
   Begin VB.Label Label1
      Alignment       =   1  'Right Justify
      Caption         =   "Diameter (d) :"
      Height          =   255
      Left            =   360
      TabIndex        =   2
      Top             =   2400
      Width           =   1215
   End
End
Attribute VB_Name = "frmSample"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Me.Hide
End Sub

Private Sub Form_Load()
Dim i%, iDef%
    For i = 0 To List1.ListCount - 1
        If List1.List(i) = TypeN Then iDef = i
    Next i
    List1.ListIndex = iDef
    For i = 0 To List2.ListCount - 1
        If List2.List(i) = ViewN Then iDef = i
    Next i
    List2.ListIndex = iDef

  '  HexNut.Visible = False
  '  HexFlangeNut.Visible = False
  '  HexSlottedNut.Visible = False
  '  LowCrownNut.Visible = False
  '  SquareNut.Visible = False

'    If List1.Text = "HexNut" Then HexNut.Visible = True
'    If List1.Text = "HexFlangeNut" Then HexFlangeNut.Visible = True
'    If List1.Text = "HexSlottedNut" Then HexSlottedNut.Visible = True
'    If List1.Text = "LowCrownNut" Then LowCrownNut.Visible = True
'    If List1.Text = "SquareNut" Then SquareNut.Visible = True
    If List1.Text = "HexNut" Then PicPreview.Picture = LoadResPicture(101, 0)
    If List1.Text = "HexFlangeNut" Then PicPreview.Picture = LoadResPicture(102, 0)
    If List1.Text = "HexSlottedNut" Then PicPreview.Picture = LoadResPicture(103, 0)
    If List1.Text = "LowCrownNut" Then PicPreview.Picture = LoadResPicture(104, 0)
    If List1.Text = "SquareNut" Then PicPreview.Picture = LoadResPicture(105, 0)

End Sub

Private Sub Label3_Click()

End Sub

Private Sub List1_Click()
'    HexNut.Visible = False
'    HexFlangeNut.Visible = False
'    HexSlottedNut.Visible = False
'    LowCrownNut.Visible = False
'    SquareNut.Visible = False

'    If List1.Text = "HexNut" Then HexNut.Visible = True
'    If List1.Text = "HexFlangeNut" Then HexFlangeNut.Visible = True
'    If List1.Text = "HexSlottedNut" Then HexSlottedNut.Visible = True
'    If List1.Text = "LowCrownNut" Then LowCrownNut.Visible = True
'    If List1.Text = "SquareNut" Then SquareNut.Visible = True
    If List1.Text = "HexNut" Then PicPreview.Picture = LoadResPicture(101, 0)
    If List1.Text = "HexFlangeNut" Then PicPreview.Picture = LoadResPicture(102, 0)
    If List1.Text = "HexSlottedNut" Then PicPreview.Picture = LoadResPicture(103, 0)
    If List1.Text = "LowCrownNut" Then PicPreview.Picture = LoadResPicture(104, 0)
    If List1.Text = "SquareNut" Then PicPreview.Picture = LoadResPicture(105, 0)

End Sub


Examples - Roughness Symbol Regen - Lay.frm

Lay.frm

Roughness Symbol Regen Example

VERSION 5.00
Begin VB.Form frmLay
   ClientHeight    =   2805
   ClientLeft      =   60
   ClientTop       =   60
   ClientWidth     =   345
   ControlBox      =   0   'False
   LinkTopic       =   "Form1"
   ScaleHeight     =   2805
   ScaleWidth      =   345
   Begin VB.Image Image0
      BorderStyle     =   1  'Fixed Single
      Height          =   420
      Left            =   0
      Picture         =   "Lay.frx":0000
      ToolTipText     =   "Lay symbol is absent"
      Top             =   0
      Width           =   420
   End
   Begin VB.Image Image7
      BorderStyle     =   1  'Fixed Single
      Height          =   420
      Left            =   0
      Picture         =   "Lay.frx":01A2
      ToolTipText     =   "Lay particulate, non-directional,or protuberant"
      Top             =   1440
      Width           =   420
   End
   Begin VB.Image Image6
      BorderStyle     =   1  'Fixed Single
      Height          =   420
      Left            =   0
      Picture         =   "Lay.frx":0344
      ToolTipText     =   "Lay approximately radial relative to the center of the surface"
      Top             =   1800
      Width           =   420
   End
   Begin VB.Image Image5
      BorderStyle     =   1  'Fixed Single
      Height          =   420
      Left            =   0
      Picture         =   "Lay.frx":04E6
      ToolTipText     =   "Lay multidirectional"
      Top             =   2520
      Width           =   420
   End
   Begin VB.Image Image4
      BorderStyle     =   1  'Fixed Single
      Height          =   420
      Left            =   0
      Picture         =   "Lay.frx":0688
      ToolTipText     =   "Lay approximately circular relative to the center of the surface"
      Top             =   2160
      Width           =   420
   End
   Begin VB.Image Image3
      BorderStyle     =   1  'Fixed Single
      Height          =   420
      Left            =   0
      Picture         =   "Lay.frx":082A
      ToolTipText     =   "Lay angular in both directions to line representing the surface"
      Top             =   1080
      Width           =   420
   End
   Begin VB.Image Image2
      BorderStyle     =   1  'Fixed Single
      Height          =   420
      Left            =   0
      Picture         =   "Lay.frx":09CC
      ToolTipText     =   "lay approximately perpendicular to the line representing the surface"
      Top             =   720
      Width           =   420
   End
   Begin VB.Image Image1
      BorderStyle     =   1  'Fixed Single
      Height          =   420
      Left            =   0
      Picture         =   "Lay.frx":0B6E
      ToolTipText     =   "Lay approximately parallel to the line representing the surface"
      Top             =   360
      Width           =   420
   End
End
Attribute VB_Name = "frmLay"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Im10%

'Private Sub Cancel_Click()
'    Call EscClick
'End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub Form_Load()
    Im10 = Im1

End Sub

Private Sub Image0_Click()
    frmRough.Image1.Picture = frmLay.Image0.Picture
    Im1 = 0
    Me.Hide
End Sub

Private Sub Image1_Click()
    frmRough.Image1.Picture = frmLay.Image1.Picture
    Im1 = 1
    Me.Hide
End Sub

Private Sub Image2_Click()
    frmRough.Image1.Picture = frmLay.Image2.Picture
    Im1 = 2
    Me.Hide
End Sub

Private Sub Image3_Click()
    frmRough.Image1.Picture = frmLay.Image3.Picture
    Im1 = 3
    Me.Hide
End Sub

Private Sub Image4_Click()
    frmRough.Image1.Picture = frmLay.Image4.Picture
    Im1 = 4
    Me.Hide
End Sub

Private Sub Image5_Click()
    frmRough.Image1.Picture = frmLay.Image5.Picture
    Im1 = 5
    Me.Hide
End Sub

Private Sub Image6_Click()
    frmRough.Image1.Picture = frmLay.Image6.Picture
    Im1 = 6
    Me.Hide
End Sub

Private Sub Image7_Click()
    frmRough.Image1.Picture = frmLay.Image7.Picture
    Im1 = 7
    Me.Hide
End Sub

'Private Sub OK_Click()
'    Me.Hide
'End Sub
Private Sub EscClick()
    Im1 = Im10
    If Im1 = 0 Then frmRough.Image1.Picture = frmLay.Image0.Picture
    If Im1 = 1 Then frmRough.Image1.Picture = frmLay.Image1.Picture
    If Im1 = 2 Then frmRough.Image1.Picture = frmLay.Image2.Picture
    If Im1 = 3 Then frmRough.Image1.Picture = frmLay.Image3.Picture
    If Im1 = 4 Then frmRough.Image1.Picture = frmLay.Image4.Picture
    If Im1 = 5 Then frmRough.Image1.Picture = frmLay.Image5.Picture
    If Im1 = 6 Then frmRough.Image1.Picture = frmLay.Image6.Picture
    If Im1 = 7 Then frmRough.Image1.Picture = frmLay.Image7.Picture
    Me.Hide
End Sub


Examples - Roughness Symbol Regen - Rough.bas

Rough.bas

Roughness Symbol Regen Example

Attribute VB_Name = "modRough"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
Global Im0 As Integer
Global Im1 As Integer
Global Str10$
Global Str20$
Global Str30$
Global Str40$
Global Str50$
Global Str60$
Global Im00%
Global Im10%
Global LetterHeight0$

Global Pi#

' DLL Entry point
Sub Main()
    Pi = 3.14159
    Im0 = 0
    Im1 = 0
End Sub


Examples - Roughness Symbol Regen - Rough.cls

Rough.cls

Roughness Symbol Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ANSI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2000                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idText1 = 1
Const idText2 = 2
Const idText3 = 3
Const idText4 = 4
Const idText5 = 5
Const idText6 = 6

Const idImg0 = 7
Const idImg1 = 8

Const idHSym = 9

'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 9
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "Surface Roughness"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{FDB6F1CA-9631-11d1-A40A-0000B465872B}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)

'    Names(0) = "Text11"
    Names(0) = "RougMinHeight"
    Types(0) = typeString
    IDs(0) = idText1
    Defaults(0) = "0.05"

'    Names(1) = "Text21"
    Names(1) = "RougMaxHeight"
    Types(1) = typeString
    IDs(1) = idText2
    Defaults(1) = ""

'    Names(2) = "Text31"
    Names(2) = "RougRemovalStock"
    Types(2) = typeString
    IDs(2) = idText3
    Defaults(2) = ""

'    Names(3) = "Text41"
    Names(3) = "RougCutOff"
    Types(3) = typeString
    IDs(3) = idText4
    Defaults(3) = ""

'    Names(4) = "Text51"
    Names(4) = "RougWidth"
    Types(4) = typeString
    IDs(4) = idText5
    Defaults(4) = ""

'    Names(5) = "Text61"
    Names(5) = "RougWavinessHeight"
    Types(5) = typeString
    IDs(5) = idText6
    Defaults(5) = ""
'// Surface Roughness type
'    Names(6) = "Image0"
    Names(6) = "RougType"
    Types(6) = typeInteger
    IDs(6) = idImg0
    Defaults(6) = 0

'    Names(7) = "Image1"
    Names(7) = "RougLaySymbol"
    Types(7) = typeInteger
    IDs(7) = idImg1
    Defaults(7) = 0

'Begin Scale

    Names(8) = "HSym"
    Types(8) = typeDouble
    IDs(8) = idHSym
    Defaults(8) = 0.25

'End Scale
    GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmRough
    Names(0) = frmRough.Caption
    Unload frmRough

'    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    StockPages = ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
    GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed
Dim Str1$, Str2$, Str3$, Str4$, Str5$, Str6$
Dim FontHeight As Double
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmRough
               'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next
                Str1 = .Text1.Text
'                Graphic.Properties("Text11") = Str1
                Graphic.Properties("RougMinHeight") = Str1

                Str2 = .Text2.Text
'                Graphic.Properties("Text21") = Str2
                Graphic.Properties("RougMaxHeight") = Str2

                Str3 = .Text3.Text
'                Graphic.Properties("Text31") = Str3
                Graphic.Properties("RougRemovalStock") = Str3

                Str4 = .Text4.Text
'                Graphic.Properties("Text41") = Str4
                Graphic.Properties("RougCutOff") = Str4

                Str5 = .Text5.Text
'                Graphic.Properties("Text51") = Str5
                Graphic.Properties("RougWidth") = Str5

                Str6 = .Text6.Text
'                Graphic.Properties("Text61") = Str6
                Graphic.Properties("RougWavinessHeight") = Str6

'                Graphic.Properties("Image0") = Im0
                Graphic.Properties("RougType") = Im0

'                Graphic.Properties("Image1") = Im1
                Graphic.Properties("RougLaySymbol") = Im1

                FontHeight = CDbl(.LetterHeight.Text)
                Graphic.Properties("HSym") = FontHeight

            End With

        Else
            'Property page is about to be opened
            'Make sure the form is loaded
'//            Im0 = Graphic.Properties("Image0")
'//            Im1 = Graphic.Properties("Image1")
            Im0 = Graphic.Properties("RougType")
            Im1 = Graphic.Properties("RougLaySymbol")
            Load frmRough
            With frmRough
                'If more than one Rough-symbol is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType
                Str1 = Graphic.Properties("RougMinHeight")
                .Text1.Text = Str1
                Str10 = Str1

                Str2 = Graphic.Properties("RougMaxHeight")
                .Text2.Text = Str2
                Str20 = Str2

                Str3 = Graphic.Properties("RougRemovalStock")
                .Text3.Text = Str3
                 Str30 = Str3

                Str4 = Graphic.Properties("RougCutOff")
                .Text4.Text = Str4
                Str40 = Str4

                Str5 = Graphic.Properties("RougWidth")
                .Text5.Text = Str5
                Str50 = Str5

                 Str6 = Graphic.Properties("RougWavinessHeight")
                .Text6.Text = Str6
                Str60 = Str6

'                Im0 = Graphic.Properties("Image0")
'                Im1 = Graphic.Properties("Image1")
                FontHeight = Graphic.Properties("HSym")
                .LetterHeight.Text = CStr(FontHeight)
                LetterHeight0 = CStr(FontHeight)
NoRType:
            End With

        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmRough
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmRough
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If
    Im0 = 0
    Im1 = 0
    On Error Resume Next
    grfThis.Properties("Thickness") = 0
    Err.Clear
    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "lower left" corner
    grfThis.Vertices.Add 1#, 0#, 0#, False, True, True, True, True
    'Second Vertex is additional
    grfThis.Vertices.Add 1.5, 0#, 0#, False, True, True, True, True
    grfThis.Properties("LimitVertices") = 2
    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis1 As Object)
        'Setup error handler

        On Error GoTo Failed
Dim grfThis As Graphic
        Set grfThis = grfThis1
        grfThis.Properties("PenStyle") = "CONTINUOUS"
        'Set up lock (prevent recursion)
        Dim LockCount&
        LockCount& = grfThis.RegenLock
        Dim Col As Long
        Col = grfThis.Properties("PenColor")
        'Setup error handler (make sure lock is removed)
        On Error Resume Next
        grfThis.Properties("Thickness") = 0
        Err.Clear

        On Error GoTo FailedLock
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
            grfThis.Graphics.Clear gfCosmetic

Dim W#, H#, R#, Hs#
Dim Str1$, Str2$, Str3$, Str4$, Str5$, Str6$
Dim Gr As Graphic

            Str1 = grfThis.Properties("RougMinHeight")
            Str2 = grfThis.Properties("RougMaxHeight")
            Str3 = grfThis.Properties("RougRemovalStock")
            Str4 = grfThis.Properties("RougCutOff")
            Str5 = grfThis.Properties("RougWidth")
            Str6 = grfThis.Properties("RougWavinessHeight")
            Im0 = grfThis.Properties("RougType")
            Im1 = grfThis.Properties("RougLaySymbol")
            H = grfThis.Properties("HSym")
            Hs = H

            'Add child Graphics
Dim Salp#, Calp#, L#
Dim X00#, Y00#, X01#, Y01#
            With grfThis.Vertices
                X00 = .Item(0).X
                Y00 = .Item(0).Y
                X01 = .Item(1).X
                Y01 = .Item(1).Y
                L = Sqr((X01 - X00) * (X01 - X00) + (Y01 - Y00) * (Y01 - Y00))
                Salp = (Y01 - Y00) / L
                Calp = (X01 - X00) / L
            End With
Dim alp#
            If Calp = 0# Then
               If Salp > 0 Then
                   alp = Pi / 2#
                   GoTo LL
               End If
               If Salp < 0 Then
                   alp = 3# * Pi / 2#
                   GoTo LL
               End If
            End If

            If Salp >= 0# And Calp > 0# Then
               alp = Atn(Abs(Salp / Calp))
            End If
            If Salp >= 0# And Calp < 0# Then
               alp = Pi - Atn(Abs(Salp / Calp))
            End If
            If Salp <= 0# And Calp < 0# Then
               alp = Pi + Atn(Abs(Salp / Calp))
            End If
            If Salp <= 0# And Calp > 0# Then
               alp = 2# * Pi - Atn(Abs(Salp / Calp))
            End If
LL:
            If alp > 6.28 Then alp = 0#
            If alp < 0.01 Then alp = 0#

'MsgBox ("alp=" & CStr(alp))
            Salp = Sin(alp)
            Calp = Cos(alp)
Dim X(30) As Double
Dim Y(30) As Double
Dim i As Long

Dim Xb#, Yb#

Dim xSymMin#, ySymMin#, xSymMax#, ySymMax#, xSymMid#, ySymMid#
' -------------------------------------------------------------
'------------------------------------------------------
' Symbol  Symbol  Symbol  Symbol  Symbol  Symbol

            xSymMin = -H * Tan(Pi / 6#)
            ySymMin = 0
            xSymMax = 2# * H * Tan(Pi / 6#)
            ySymMax = 2# * H
            xSymMid = H * Tan(Pi / 6#)
            ySymMid = H

            If Im0 = 0 Then
                X(1) = -H * Tan(Pi / 6#)
                Y(1) = H
                X(2) = 0#
                Y(2) = 0#
                X(3) = 2# * H * Tan(Pi / 6#)
                Y(3) = 2# * H
                Set Gr = grfThis.Graphics.Add(11)
                Gr.Properties("PenStyle") = "CONTINUOUS"
                Gr.Cosmetic = True
                With Gr.Vertices
                    .Add X(1), Y(1), 0
                    .Add X(2), Y(2), 0
                    .Add X(3), Y(3), 0
                End With
                Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
                Gr.MoveRelative X00, Y00, 0
                Gr.Properties("PenColor") = Col 'grfThis.Properties("PenColor")
            End If

            If Im0 = 1 Then
                X(1) = -H * Tan(Pi / 6#)
                Y(1) = H
                X(2) = 0#
                Y(2) = 0#
                X(3) = 2# * H * Tan(Pi / 6#)
                Y(3) = 2# * H
                X(4) = H * Tan(Pi / 6#)
                Y(4) = H
                Set Gr = grfThis.Graphics.Add(11)
                Gr.Properties("PenStyle") = "CONTINUOUS"
                Gr.Cosmetic = True
                With Gr.Vertices
                    .Add X(4), Y(4), 0
                    .Add X(1), Y(1), 0
                    .Add X(2), Y(2), 0
                    .Add X(3), Y(3), 0
                End With
                Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
                Gr.MoveRelative X00, Y00, 0
                Gr.Properties("PenColor") = Col 'grfThis.Properties("PenColor")
            End If
            If Im0 = 2 Then
                X(1) = -H * Tan(Pi / 6#)
                Y(1) = H
                X(2) = 0#
                Y(2) = 0#
                X(3) = 2# * H * Tan(Pi / 6#)
                Y(3) = 2# * H
                X(4) = 0#
                Y(4) = 2# / 3# * H
                X(5) = 1# / 3# * H
                Y(5) = 2# / 3# * H

                Set Gr = grfThis.Graphics.Add(11)
                Gr.Cosmetic = True
                Gr.Properties("PenStyle") = "CONTINUOUS"
                With Gr.Vertices
                    .Add X(1), Y(1), 0
                    .Add X(2), Y(2), 0
                    .Add X(3), Y(3), 0
                End With
                Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
                Gr.MoveRelative X00, Y00, 0
                Gr.Properties("PenColor") = Col 'grfThis.Properties("PenColor")
                Set Gr = grfThis.Graphics.AddCircleCenterAndPoint(X(4), Y(4), 0, X(5), Y(5), 0)
                        Gr.Cosmetic = True
                        Gr.Properties("PenStyle") = "CONTINUOUS"
                Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
                Gr.MoveRelative X00, Y00, 0
                Gr.Properties("PenColor") = Col 'grfThis.Properties("PenColor")
            End If

Dim BBox As BoundingBox
'--------------------------------------------------------------
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Text Filds Text2=Str2  Text3=Str3  Text4=Str4
Dim xMax#, yMax#, xMin#, yMin#
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        ' text1
            If Len(Str1) > 0 Then
                If alp <= 1.001 * Pi / 2# Or alp >= 0.999 * 3# * Pi / 2# Then
                    Set Gr = grfThis.Graphics.AddText(Str1, 0, 0, 0, Hs)
                                Gr.Cosmetic = True
               Else
                    Set Gr = grfThis.Graphics.AddText(Str1, 0, 0, 0, Hs, Pi)
                                Gr.Cosmetic = True
               End If
                xMax = Gr.CalcBoundingBox.Max.X
                yMax = Gr.CalcBoundingBox.Max.Y
                xMin = Gr.CalcBoundingBox.Min.X
                yMin = Gr.CalcBoundingBox.Min.Y
                Gr.MoveRelative xSymMid - xMax, ySymMid - yMin, 0
                Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
                Gr.MoveRelative X00, Y00, 0
                Gr.Properties("PenColor") = Col 'grfThis.Properties("PenColor")
            End If
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    ' text2

            If Len(Str2) > 0 Then
                If alp <= 1.001 * Pi / 2# Or alp >= 0.999 * 3# * Pi / 2# Then
                    Set Gr = grfThis.Graphics.AddText(Str2, 0, 0, 0, Hs)
                               Gr.Cosmetic = True
                Else
                    Set Gr = grfThis.Graphics.AddText(Str2, 0, 0, 0, Hs, Pi)
                                Gr.Cosmetic = True
                End If
                xMax = Gr.CalcBoundingBox.Max.X
                yMax = Gr.CalcBoundingBox.Max.Y
                xMin = Gr.CalcBoundingBox.Min.X
                yMin = Gr.CalcBoundingBox.Min.Y
                Gr.MoveRelative xSymMid - xMax, ySymMax - yMin, 0
                Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
                Gr.MoveRelative X00, Y00, 0
                Gr.Properties("PenColor") = Col 'grfThis.Properties("PenColor")
           End If
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        'text 3
            If Len(Str3) > 0 Then
                If alp <= 1.001 * Pi / 2# Or alp >= 0.999 * 3# * Pi / 2# Then
                    Set Gr = grfThis.Graphics.AddText(Str3, 0, 0, 0, Hs, 0)
                                Gr.Cosmetic = True
                Else
                    Set Gr = grfThis.Graphics.AddText(Str3, 0, 0, 0, Hs, Pi)
                                Gr.Cosmetic = True
               End If

                xMax = Gr.CalcBoundingBox.Max.X
                yMax = Gr.CalcBoundingBox.Max.Y
                xMin = Gr.CalcBoundingBox.Min.X
                yMin = Gr.CalcBoundingBox.Min.Y
                Gr.MoveRelative xSymMin - xMax, ySymMin - yMin, 0
                Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
                Gr.MoveRelative X00, Y00, 0
                Gr.Properties("PenColor") = Col 'grfThis.Properties("PenColor")
            End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++
    ' Text4
Dim dx4#
             dx4 = 0
             If Len(Str4) > 0 Then
                 If alp <= 1.001 * Pi / 2# Or alp >= 0.999 * 3# * Pi / 2# Then
                     Set Gr = grfThis.Graphics.AddText(Str4, Xb, Yb, 0, Hs, 0)
                                 Gr.Cosmetic = True
                 Else
                     Set Gr = grfThis.Graphics.AddText(Str4, Xb, Yb, 0, Hs, Pi)
                                 Gr.Cosmetic = True
                 End If
                 xMax = Gr.CalcBoundingBox.Max.X
                 yMax = Gr.CalcBoundingBox.Max.Y
                 xMin = Gr.CalcBoundingBox.Min.X
                 yMin = Gr.CalcBoundingBox.Min.Y
                 Gr.MoveRelative xSymMax - xMin, ySymMid - yMin, 0
                 dx4 = Abs(xMax - xMin)
                 Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
                 Gr.MoveRelative X00, Y00, 0
                Gr.Properties("PenColor") = Col 'grfThis.Properties("PenColor")
            End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Dim dxb#
            dxb = 0
            If Im1 = 1 Then
                    X(1) = -0.35 * H
                    Y(1) = -0.15 * H
                    X(2) = 0.35 * H
                    Y(2) = Y(1)
                    X(3) = X(1)
                    Y(3) = 0.15 * H
                    X(4) = X(2)
                    Y(4) = Y(3)
                    Set Gr = grfThis.Graphics.Add(11)
                        Gr.Cosmetic = True
                        Gr.Properties("PenStyle") = "CONTINUOUS"
                    With Gr.Vertices
                        .Add X(1), Y(1), 0
                        .Add X(2), Y(2), 0
                        .Add X(3), Y(3), 0, False
                        .Add X(4), Y(4), 0
                    End With

                If alp > 1.001 * Pi / 2# And alp < 0.999 * 3# * Pi / 2# Then
                    Gr.RotateAxis Pi, 0, 0, 1
                End If
                xMax = Gr.CalcBoundingBox.Max.X
                yMax = Gr.CalcBoundingBox.Max.Y
                xMin = Gr.CalcBoundingBox.Min.X
                yMin = Gr.CalcBoundingBox.Min.Y
                Gr.MoveRelative xSymMid - xMin, ySymMin - yMin, 0
                If alp > 1.001 * Pi / 2# And alp < 0.999 * 3# * Pi / 2# Then
                    Gr.MoveRelative 0, Hs / 2, 0
                Else
                    Gr.MoveRelative 0, Hs / 4, 0
                End If
'                Gr.MoveRelative 0, Hs / 4, 0
                Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
                Gr.MoveRelative X00, Y00, 0
                Gr.Properties("PenColor") = Col 'grfThis.Properties("PenColor")
                dxb = Abs(xMax - xMin)
            End If

            If Im1 = 2 Then
                X(1) = -0.4 * H
                Y(1) = 0.1 * H
                X(2) = 0.4 * H
                Y(2) = Y(1)
                X(3) = (X(1) + X(2)) / 2
                Y(3) = Y(1)
                X(4) = X(3)
                Y(4) = Y(1) + 0.6 * H
                Set Gr = grfThis.Graphics.Add(11)
                        Gr.Cosmetic = True
                        Gr.Properties("PenStyle") = "CONTINUOUS"
                With Gr.Vertices
                    .Add X(1), Y(1), 0
                    .Add X(2), Y(2), 0
                    .Add X(3), Y(3), 0, False
                    .Add X(4), Y(4), 0
                End With

                If alp > 1.001 * Pi / 2# And alp < 0.999 * 3# * Pi / 2# Then
                    Gr.RotateAxis Pi, 0, 0, 1
                End If
                xMax = Gr.CalcBoundingBox.Max.X
                yMax = Gr.CalcBoundingBox.Max.Y
                xMin = Gr.CalcBoundingBox.Min.X
                yMin = Gr.CalcBoundingBox.Min.Y
                Gr.MoveRelative xSymMid - xMin, ySymMin - yMin, 0
                If alp > 1.001 * Pi / 2# And alp < 0.999 * 3# * Pi / 2# Then
                    Gr.MoveRelative 0, Hs / 4, 0
                Else
                    Gr.MoveRelative 0, Hs / 8, 0
                End If
                Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
                Gr.MoveRelative X00, Y00, 0
                Gr.Properties("PenColor") = Col 'grfThis.Properties("PenColor")
                dxb = Abs(xMax - xMin)
            End If

Dim Str As String
            If Im1 > 2 Then
                If Im1 = 3 Then Str = "X"
                If Im1 = 4 Then Str = "C"
                If Im1 = 5 Then Str = "M"
                If Im1 = 6 Then Str = "R"
                If Im1 = 7 Then Str = "P"

                If alp <= 1.001 * Pi / 2# Or alp >= 0.999 * 3# * Pi / 2# Then
                    Set Gr = grfThis.Graphics.AddText(Str, 0, 0, 0, Hs)
                                Gr.Cosmetic = True
                Else
                    Set Gr = grfThis.Graphics.AddText(Str, 0, 0, 0, Hs, Pi)
                                Gr.Cosmetic = True
               End If
                xMax = Gr.CalcBoundingBox.Max.X
                yMax = Gr.CalcBoundingBox.Max.Y
                xMin = Gr.CalcBoundingBox.Min.X
                yMin = Gr.CalcBoundingBox.Min.Y
                Gr.MoveRelative xSymMid - xMin, ySymMin - yMin, 0
                Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
                Gr.MoveRelative X00, Y00, 0
                Gr.Properties("PenColor") = Col 'grfThis.Properties("PenColor")
                dxb = Abs(xMax - xMin)
            End If

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

Dim dX5#
            dX5 = 0#
            If Len(Str5) > 0 Then
                If alp <= 1.001 * Pi / 2# Or alp >= 0.999 * 3# * Pi / 2# Then
                    Set Gr = grfThis.Graphics.AddText(Str5, 0, 0, 0, Hs, 0)
                                Gr.Cosmetic = True
                Else
                    Set Gr = grfThis.Graphics.AddText(Str5, 0, 0, 0, Hs, Pi)
                                Gr.Cosmetic = True
                End If
                xMax = Gr.CalcBoundingBox.Max.X
                yMax = Gr.CalcBoundingBox.Max.Y
                xMin = Gr.CalcBoundingBox.Min.X
                yMin = Gr.CalcBoundingBox.Min.Y
                dX5 = Abs(xMax - xMin)
                Gr.MoveRelative xSymMid + 1.2 * dxb - xMin, ySymMin - yMin, 0
                Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
                Gr.MoveRelative X00, Y00, 0
                Gr.Properties("PenColor") = Col 'grfThis.Properties("PenColor")
            End If

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++
        ' text 6

Dim dx6#
            dx6 = 0
            If Len(Str6) > 0 Then
                If alp <= 1.001 * Pi / 2# Or alp >= 0.999 * 3# * Pi / 2# Then
                    Set Gr = grfThis.Graphics.AddText(Str6, 0, 0, 0, Hs, 0)
                                Gr.Cosmetic = True
                Else
                    Set Gr = grfThis.Graphics.AddText(Str6, 0, 0, 0, Hs, Pi)
                                Gr.Cosmetic = True
                End If
                xMax = Gr.CalcBoundingBox.Max.X
                yMax = Gr.CalcBoundingBox.Max.Y
                xMin = Gr.CalcBoundingBox.Min.X
                yMin = Gr.CalcBoundingBox.Min.Y
                Gr.MoveRelative xSymMax - xMin, ySymMax - yMin, 0
                dx6 = Abs(xMax - xMin)
                Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
                Gr.MoveRelative X00, Y00, 0
                Gr.Properties("PenColor") = Col 'grfThis.Properties("PenColor")
            End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    ' add line
Dim dxMax#
            dxMax = 0
            If dx4 > dxMax Then dxMax = dx4
            If dxb + dX5 > dxMax Then dxMax = dxb + dX5
            If dx6 > dxMax Then dxMax = dx6

            If Abs(xMax) > 0.0001 Then
                X(1) = xSymMax
                Y(1) = ySymMax
                X(2) = X(1) + dxMax
                Set Gr = grfThis.Graphics.Add(11)
                    Gr.Cosmetic = True
                With Gr.Vertices
                    .Add X(1), Y(1), 0
                    .Add X(2), Y(1), 0
                End With
                Gr.RotateAxis alp, 0, 0, 1, 0, 0, 0
                Gr.MoveRelative X00, Y00, 0
                Gr.Properties("PenColor") = Col 'grfThis.Properties("PenColor")
            End If
            'Add visible child Graphics
Dim CountCosm As Long, iCosm As Long, nV As Long, iV As Long, xi#, yi#, xir#, yir#
        Dim GrChild As Graphic
            CountCosm = grfThis.Graphics.Count
            For iCosm = 0 To CountCosm - 1
                Set GrChild = grfThis.Graphics.Item(iCosm)
'                If iCosm <> 0 Then
                    On Error Resume Next
                    GrChild.Properties("PenStyle") = "CONTINUOUS"
                    GrChild.Properties("Thickness") = 0
                    GrChild.Update
'                End If
               Set GrChild = Nothing
            Next iCosm
            Err.Clear

        End If
LLL:

        X01 = X00 + (xSymMax + dxMax) * Calp
        Y01 = Y00 + (xSymMax + dxMax) * Salp
        grfThis.Vertices(1).X = X01
        grfThis.Vertices(1).Y = Y01

        grfThis.RegenUnlock

        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:

        If Err.Number <> 0 Then
            MsgBox "Regen error: " & Err.Description
        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function


Examples - Roughness Symbol Regen - Rough.frm

Rough.frm

Roughness Symbol Regen Example

VERSION 5.00
Begin VB.Form frmRough
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Surface Roughness"
   ClientHeight    =   3765
   ClientLeft      =   6420
   ClientTop       =   2910
   ClientWidth     =   6045
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3765
   ScaleWidth      =   6045
   Begin VB.TextBox Text3
      Height          =   288
      Left            =   1875
      TabIndex        =   20
      ToolTipText     =   "Amount of stock to be removal by machining"
      Top             =   2205
      Width           =   1170
   End
   Begin VB.TextBox Text5
      Height          =   288
      Left            =   4680
      TabIndex        =   19
      ToolTipText     =   "Maximum roughness spacing"
      Top             =   2205
      Width           =   1200
   End
   Begin VB.TextBox Text1
      Height          =   288
      Left            =   3225
      TabIndex        =   18
      ToolTipText     =   "Roughness average rating (or minimum)"
      Top             =   1200
      Width           =   900
   End
   Begin VB.TextBox Text2
      Height          =   288
      Left            =   3225
      TabIndex        =   17
      ToolTipText     =   "Maximum roughness avarage value"
      Top             =   615
      Width           =   900
   End
   Begin VB.TextBox Text4
      Height          =   288
      Left            =   4665
      TabIndex        =   16
      ToolTipText     =   "Roughness sampling lenght or cutoff rating"
      Top             =   1485
      Width           =   1215
   End
   Begin VB.TextBox Text6
      Height          =   288
      Left            =   4620
      TabIndex        =   15
      ToolTipText     =   "Maximum waviness height rating"
      Top             =   615
      Width           =   1212
   End
   Begin VB.OptionButton Option2
      Height          =   255
      Left            =   990
      TabIndex        =   5
      ToolTipText     =   "Material Removal By Machining Is Required"
      Top             =   1440
      Width           =   255
   End
   Begin VB.OptionButton Option3
      Height          =   255
      Left            =   1005
      TabIndex        =   1
      ToolTipText     =   "Material Removal Prohibited"
      Top             =   2175
      Width           =   255
   End
   Begin VB.OptionButton Option1
      Height          =   255
      Left            =   1005
      TabIndex        =   0
      ToolTipText     =   "Basic Texture Symbol"
      Top             =   735
      Value           =   -1  'True
      Width           =   255
   End
   Begin VB.TextBox LetterHeight
      Height          =   285
      Left            =   135
      TabIndex        =   2
      ToolTipText     =   "Letter Height"
      Top             =   3240
      Width           =   975
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   3030
      TabIndex        =   3
      Top             =   3165
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   4620
      TabIndex        =   4
      Top             =   3150
      Width           =   1215
   End
   Begin VB.Frame Frame1
      BackColor       =   &H8000000B&
      Caption         =   "Type:"
      ClipControls    =   0   'False
      Height          =   2460
      Left            =   120
      TabIndex        =   14
      Top             =   240
      Width           =   1335
      Begin VB.Line Line16
         X1              =   120
         X2              =   240
         Y1              =   600
         Y2              =   840
      End
      Begin VB.Line Line15
         X1              =   240
         X2              =   480
         Y1              =   840
         Y2              =   360
      End
      Begin VB.Line Line17
         X1              =   120
         X2              =   240
         Y1              =   1200
         Y2              =   1440
      End
      Begin VB.Line Line18
         X1              =   240
         X2              =   480
         Y1              =   1440
         Y2              =   960
      End
      Begin VB.Line Line11
         X1              =   120
         X2              =   240
         Y1              =   1920
         Y2              =   2160
      End
      Begin VB.Line Line12
         X1              =   240
         X2              =   480
         Y1              =   2160
         Y2              =   1680
      End
      Begin VB.Line Line19
         X1              =   120
         X2              =   360
         Y1              =   1200
         Y2              =   1200
      End
      Begin VB.Shape Shape2
         Height          =   255
         Left            =   180
         Shape           =   3  'Circle
         Top             =   1830
         Width           =   135
      End
   End
   Begin VB.Label Label1
      Caption         =   "Font Height"
      Height          =   255
      Left            =   120
      TabIndex        =   13
      Top             =   2895
      Width           =   975
   End
   Begin VB.Label Label8
      Caption         =   "Lay :"
      Height          =   270
      Left            =   4170
      TabIndex        =   12
      Top             =   1875
      Width           =   495
   End
   Begin VB.Label Label7
      Caption         =   "Width :"
      Height          =   300
      Left            =   4665
      TabIndex        =   11
      Top             =   1875
      Width           =   645
   End
   Begin VB.Label Label6
      Caption         =   "Cutoff :"
      Height          =   270
      Left            =   4665
      TabIndex        =   10
      Top             =   1155
      Width           =   630
   End
   Begin VB.Label Label5
      Caption         =   "Waviness height & width : "
      Height          =   240
      Left            =   4035
      TabIndex        =   9
      Top             =   225
      Width           =   1755
   End
   Begin VB.Label Label4
      Caption         =   "Max Height :"
      Height          =   285
      Left            =   2145
      TabIndex        =   8
      Top             =   585
      Width           =   960
   End
   Begin VB.Label Label3
      Caption         =   "Min Height :"
      Height          =   240
      Left            =   2205
      TabIndex        =   7
      Top             =   1185
      Width           =   900
   End
   Begin VB.Label Label2
      Caption         =   "Removal stock :"
      Height          =   240
      Left            =   1875
      TabIndex        =   6
      Top             =   1920
      Width           =   1290
   End
   Begin VB.Image Image1
      BorderStyle     =   1  'Fixed Single
      Height          =   375
      Left            =   4200
      ToolTipText     =   "Lay Symbol"
      Top             =   2205
      Width           =   375
   End
   Begin VB.Line Line10
      BorderWidth     =   3
      X1              =   4605
      X2              =   5805
      Y1              =   975
      Y2              =   975
   End
   Begin VB.Line Line2
      BorderColor     =   &H80000006&
      BorderWidth     =   3
      X1              =   4575
      X2              =   3660
      Y1              =   960
      Y2              =   2820
   End
   Begin VB.Line Line1
      BorderWidth     =   3
      X1              =   3195
      X2              =   3645
      Y1              =   1635
      Y2              =   2805
   End
End
Attribute VB_Name = "frmRough"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean
'Private Im00%, Im10%
'Private Str10$, Str20$, Str30$, Str40$, Str50$
'Private LetterHeight0$
' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    On Error Resume Next
    Call EscClick
    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
'    If CDbl(LetterHeight) = 0 Then
'        MsgBox "Please enter a valid text height", , "Error !"
'    Else
'        blnDialogCanceled = False
'        Me.Hide
'    End If
Dim SymTxtHeight As Double
On Error GoTo Failed
    SymTxtHeight = CDbl(LetterHeight.Text)
    If SymTxtHeight <= 0 Then GoTo Failed
        blnDialogCanceled = False
        Me.Hide
    Exit Sub
Failed:
 MsgBox "Please enter a valid Font Height", vbOKOnly, "Surface Roughness"
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Call EscClick
End Sub

Private Sub Form_Load()
    blnDialogCanceled = True

    Im00 = Im0
    Im10 = Im1
'    Str10 = frmRough.Text1.Text
'    Str20 = frmRough.Text2.Text
'    Str30 = frmRough.Text3.Text
'    Str40 = frmRough.Text4.Text
'    Str50 = frmRough.Text5.Text
'    LetterHeight.Text = 0.25
'    LetterHeight0 = frmRough.LetterHeight.Text

Dim J%
    J = Im0
    If Im0 = 0 Then
        Option1.Value = True
        Option2.Value = False
        Option3.Value = False
    End If
    If Im0 = 1 Then
        Option1.Value = False
        Option2.Value = True
        Option3.Value = False
    End If
    If Im0 = 2 Then
        Option1.Value = False
        Option2.Value = False
        Option3.Value = True
    End If
    If Im1 = 0 Then
        frmRough.Image1.Picture = frmLay.Image0.Picture
    End If
    If Im1 = 1 Then
        frmRough.Image1.Picture = frmLay.Image1.Picture
    End If
    If Im1 = 2 Then
        frmRough.Image1.Picture = frmLay.Image2.Picture
    End If
    If Im1 = 3 Then
        frmRough.Image1.Picture = frmLay.Image3.Picture
    End If
    If Im1 = 4 Then
        frmRough.Image1.Picture = frmLay.Image4.Picture
    End If
    If Im1 = 5 Then
        frmRough.Image1.Picture = frmLay.Image5.Picture
    End If
    If Im1 = 6 Then
        frmRough.Image1.Picture = frmLay.Image6.Picture
    End If
    If Im1 = 7 Then
        frmRough.Image1.Picture = frmLay.Image7.Picture
    End If

End Sub

Private Sub Image1_Click()
    frmLay.Top = frmRough.Top + frmRough.Image1.Top + 2 * frmRough.Image1.Height
    frmLay.Left = frmRough.Left + frmRough.Image1.Left
    frmLay.Show vbModal
End Sub

Private Sub Option1_Click()
    Option1.Value = True
    Option2.Value = False
    Option3.Value = False
    Im0 = 0
End Sub
Private Sub Option2_Click()
    Option1.Value = False
    Option2.Value = True
    Option3.Value = False
    Im0 = 1
End Sub
Private Sub Option3_Click()
    Option1.Value = False
    Option2.Value = False
    Option3.Value = True
    Im0 = 2
End Sub

Private Sub Symbol_Click(Index As Integer)
    Im0 = Index
End Sub

Private Sub EscClick()
On Error Resume Next
    Im0 = Im00
    Im1 = Im10
    frmRough.Text1.Text = Str10
    frmRough.Text2.Text = Str20
    frmRough.Text3.Text = Str30
    frmRough.Text4.Text = Str40
    frmRough.Text5.Text = Str50
    frmRough.Text6.Text = Str60

    frmRough.LetterHeight.Text = LetterHeight0
    If CDbl(LetterHeight) = 0 Then
        MsgBox "Please enter a valid text height", , "Error !"
    Else
        Me.Hide
        blnDialogCanceled = True
    End If

'    Me.Hide
End Sub


Examples - %%PROJECT_NAME%%RRect.bas

RRect.bas

Attribute VB_Name = "modRRect"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' DLL Entry point
Sub Main()

End Sub


Examples - %%PROJECT_NAME%%RRect.cls

RRect.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Rectangle"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idRoundness = 1

'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 1
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "SDK RoundRectangle"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{D25185FF-6A20-11d0-A115-00A024158DAF}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
    Names(0) = "Roundness"
    Types(0) = typeDouble
    IDs(0) = idRoundness
    Defaults(0) = 50#
    GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmRRect
    Names(0) = frmRRect.Caption
    Unload frmRRect

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
    GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed

        Dim Roundness#
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmRRect
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next

                'When the property page is closed, transfer the numeric
                'roundness value from the TextBox to the Graphic
                'Get the value as a double-precision number
                Roundness# = CDbl(.txtRoundness.Text)
                'Make sure it's between 0 and 100
                If Roundness# < 0# Then Roundness# = 0#
                If Roundness# > 100# Then Roundness# = 100#
                'Set the roundness property value in the Graphic
                Graphic.Properties("Roundness") = Roundness#
            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmRRect
            With frmRRect
                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                'roundness value from the Graphic to the TextBox
                'Get the roundness property value from the Graphic
                Roundness# = Graphic.Properties("Roundness")
                'Set the TextBox control's text
                .txtRoundness.Text = Roundness#
NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmRRect
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmRRect
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If

    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "lower left" corner
    grfThis.Vertices.Add -1#, -0.5, 0#, False, True, False, False, False
    'Second Vertex is "upper right" corner
    grfThis.Vertices.Add 1#, 0.5, 0#, False, True, False, False, False
    'Third Vertex is rounding handle (calculated)
    Dim R#, Roundness#, Offset#
    Roundness# = grfThis.Properties("Roundness")
    R# = 0.5 * Roundness# / 100#
    Offset# = 0.1 * R#
    grfThis.Vertices.Add 1# - R#, 0.5 + Offset#, 0#, False, False, False, False, False
    'Fourth Vertex is rounding handle (editable)
    grfThis.Vertices.Add 1# - R#, 0.5 + Offset#, 0#, False, True, False, True, False
    grfThis.Properties("LimitVertices") = 4
    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis As Object)
        'Setup error handler
        On Error GoTo Failed

        'grfThis.Application.PushVertexDefaults Editable:=True, Selectable:=True

        'Set up lock (prevent recursion)
        Dim LockCount&
        LockCount& = grfThis.RegenLock

        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
            grfThis.Graphics.Clear gfCosmetic

            Dim boolHandleMoved As Boolean

            'Calculate height, width and radius of corners
            Dim W#, H#, R#, Roundness#
            With grfThis.Vertices
                If (Abs(.Item(2).X - .Item(3).X) < 0.000001 And _
                    Abs(.Item(2).Y - .Item(3).Y) < 0.000001) Then
                    boolHandleMoved = False
                Else
                    boolHandleMoved = True
                End If
                W# = Abs(.Item(1).X - .Item(0).X)
                H# = Abs(.Item(1).Y - .Item(0).Y)
            End With
            'Radius of arcs is based on minimum of width and height
            If W# < H# Then
                R# = W# / 2#
            Else
                R# = H# / 2#
            End If
            'Adjust radius for roundness
            If boolHandleMoved Then
                Roundness# = Abs(grfThis.Vertices(2).X - grfThis.Vertices(3).X)
                Roundness# = Roundness# * 100# / R#
                If Roundness# > 100# Then Roundness# = 100#
                'Relocate handle

                'Update property to reflect handle location
                grfThis.Properties("Roundness") = Roundness#
            Else
                Roundness# = grfThis.Properties("Roundness")
                If Roundness# < 0# Then Roundness# = 0#
                If Roundness# > 100# Then Roundness# = 100#
            End If
            R# = R# * Roundness# / 100#

            'Add child Graphics
            Dim grfChild As Object
            Dim X0#, Y0#, X1#, Y1#, T#
            With grfThis.Vertices
                X0# = .Item(0).X
                Y0# = .Item(0).Y
                X1# = .Item(1).X
                Y1# = .Item(1).Y
                'Make sure X0 < X1
                If (X0# > X1#) Then
                    T# = X0#
                    X0# = X1#
                    X1# = T#
                End If
                'Make sure Y0 < Y1
                If (Y0# > Y1#) Then
                    T# = Y0#
                    Y0# = Y1#
                    Y1# = T#
                End If
            End With
            If R# = 0# Then
                'No rounded corners
                'All children are cosmetic
                Set grfChild = grfThis.Graphics.Add(gkGraphic)
                grfChild.Cosmetic = True
                'Now add vertices to the child
                With grfChild.Vertices
                    .Add X0#, Y0#, 0
                    .Add X0#, Y1#, 0, True
                    .Add X1#, Y1#, 0, True
                    .Add X1#, Y0#, 0, True
                    'Close the rectangle
                    .AddClose PenDown:=True 'PenDown
                End With
            Else
                'Rounded corners
                'We'll make 4 line children and 4 arc children
                'First line
                'All children are cosmetic
                Set grfChild = grfThis.Graphics.Add(gkGraphic)
                grfChild.Cosmetic = True
                'Now add vertices to the child
                With grfChild.Vertices
                    .Add X0# + R#, Y0#, 0
                    .Add X1# - R#, Y0#, 0, True
                End With
                'First arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet X1# - R#, Y0# + R#, 0#, R#, , 1.5 * Pi#, 0#
                'Second line
                Set grfChild = grfThis.Graphics.Add(gkGraphic)
                grfChild.Cosmetic = True
                With grfChild.Vertices
                    .Add X1#, Y0# + R#, 0
                    .Add X1#, Y1# - R#, 0, True
                End With
                'Second arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet X1# - R#, Y1# - R#, 0#, R#, , 0#, 0.5 * Pi#
                'Third line
                Set grfChild = grfThis.Graphics.Add(gkGraphic)
                grfChild.Cosmetic = True
                With grfChild.Vertices
                    .Add X1# - R#, Y1#, 0
                    .Add X0# + R#, Y1#, 0, True
                End With
                'Third arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet X0# + R#, Y1# - R#, 0#, R#, , 0.5 * Pi#, Pi#
                'Fourth line
                Set grfChild = grfThis.Graphics.Add(gkGraphic)
                grfChild.Cosmetic = True
                With grfChild.Vertices
                    .Add X0#, Y1# - R#, 0
                    .Add X0#, Y0# + R#, 0, True
                End With
                'Fourth arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet X0# + R#, Y0# + R#, 0#, R#, , Pi#, 1.5 * Pi#
            End If

            'Add visible child Graphics
        End If

        grfThis.RegenUnlock
        'grfThis.Application.PopVertexDefaults
        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:
        'grfThis.Application.PopVertexDefaults

        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function


Examples - %%PROJECT_NAME%%RRect.frm

RRect.frm

VERSION 5.00
Begin VB.Form frmRRect
   Caption         =   "Round Rectangle"
   ClientHeight    =   1470
   ClientLeft      =   6435
   ClientTop       =   2910
   ClientWidth     =   3465
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   1470
   ScaleWidth      =   3465
   Begin VB.TextBox txtRoundness
      Height          =   285
      Left            =   1680
      TabIndex        =   3
      Text            =   "50"
      Top             =   240
      Width           =   615
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   840
      Width           =   1335
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   1920
      TabIndex        =   1
      Top             =   840
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "Roundness"
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   240
      Width           =   1095
   End
End
Attribute VB_Name = "frmRRect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Me.Hide
End Sub


Examples - %%PROJECT_NAME%%CREATERR.BAS

CREATERR.BAS

'Script to create RRect Turbo Shape and add it to a TurboCAD drawing
Global Const gkGRAPHIC = &H0B
sub Main()
    Dim g As Long
    Dim r As Long
    Dim v As Long

    Dim e As String

    'Create a graphic with kind = gkGraphic and Regen Method
    'RRect.Rectangle.  TCWGraphicCreate will cause OnNewGraphic
    'to be called
    g = TCWGraphicCreate(gkGraphic, "RoundRect.Rectangle")

    'if we got an error, display error message and stop
    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
        stop
    end if

    'Need up update properties to get RegenGraphic to be called
    e = TCWGraphicPropertySet(g, "PenColor", &H00FF0000)

    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if

    'Add the graphic to the drawing
    TCWGraphicAppend 0, g

    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if

    'Force the graphic to be drawn on the drawing
    TCWGraphicDraw g, 0
    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if
end Sub


Examples - Rounded Rectangle Regen - RRect.bas

RRect.bas

Rounded Rectangle Regen Example

Attribute VB_Name = "modRRect"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' DLL Entry point
Sub Main()

End Sub


Examples - Rounded Rectangle Regen - RRect.cls

RRect.cls

Rounded Rectangle Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Rectangle"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idRoundness = 1

'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 1
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "SDK RoundRectangle"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{D25185FF-6A20-11d0-A115-00A024158DAF}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
    Names(0) = "Roundness"
    Types(0) = typeDouble
    IDs(0) = idRoundness
    Defaults(0) = 50#
    GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmRRect
    Names(0) = frmRRect.Caption
    Unload frmRRect

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
    GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed

        Dim Roundness#
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmRRect
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next

                'When the property page is closed, transfer the numeric
                'roundness value from the TextBox to the Graphic
                'Get the value as a double-precision number
                Roundness# = CDbl(.txtRoundness.Text)
                'Make sure it's between 0 and 100
                If Roundness# < 0# Then Roundness# = 0#
                If Roundness# > 100# Then Roundness# = 100#
                'Set the roundness property value in the Graphic
                Graphic.Properties("Roundness") = Roundness#
            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmRRect
            With frmRRect
                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                'roundness value from the Graphic to the TextBox
                'Get the roundness property value from the Graphic
                Roundness# = Graphic.Properties("Roundness")
                'Set the TextBox control's text
                .txtRoundness.Text = Roundness#
NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmRRect
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmRRect
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If

    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "lower left" corner
    grfThis.Vertices.Add -1#, -0.5, 0#, False, True, False, False, False
    'Second Vertex is "upper right" corner
    grfThis.Vertices.Add 1#, 0.5, 0#, False, True, False, False, False
    'Third Vertex is rounding handle (calculated)
    Dim R#, Roundness#, Offset#
    Roundness# = grfThis.Properties("Roundness")
    R# = 0.5 * Roundness# / 100#
    Offset# = 0.1 * R#
    grfThis.Vertices.Add 1# - R#, 0.5 + Offset#, 0#, False, False, False, False, False
    'Fourth Vertex is rounding handle (editable)
    grfThis.Vertices.Add 1# - R#, 0.5 + Offset#, 0#, False, True, False, True, False
    grfThis.Properties("LimitVertices") = 4
    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis As Object)
        'Setup error handler
        On Error GoTo Failed

        'grfThis.Application.PushVertexDefaults Editable:=True, Selectable:=True

        'Set up lock (prevent recursion)
        Dim LockCount&
        LockCount& = grfThis.RegenLock

        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
            grfThis.Graphics.Clear gfCosmetic

            Dim boolHandleMoved As Boolean

            'Calculate height, width and radius of corners
            Dim W#, H#, R#, Roundness#
            With grfThis.Vertices
                If (Abs(.Item(2).X - .Item(3).X) < 0.000001 And _
                    Abs(.Item(2).Y - .Item(3).Y) < 0.000001) Then
                    boolHandleMoved = False
                Else
                    boolHandleMoved = True
                End If
                W# = Abs(.Item(1).X - .Item(0).X)
                H# = Abs(.Item(1).Y - .Item(0).Y)
            End With
            'Radius of arcs is based on minimum of width and height
            If W# < H# Then
                R# = W# / 2#
            Else
                R# = H# / 2#
            End If
            'Adjust radius for roundness
            If boolHandleMoved Then
                Roundness# = Abs(grfThis.Vertices(2).X - grfThis.Vertices(3).X)
                Roundness# = Roundness# * 100# / R#
                If Roundness# > 100# Then Roundness# = 100#
                'Relocate handle

                'Update property to reflect handle location
                grfThis.Properties("Roundness") = Roundness#
            Else
                Roundness# = grfThis.Properties("Roundness")
                If Roundness# < 0# Then Roundness# = 0#
                If Roundness# > 100# Then Roundness# = 100#
            End If
            R# = R# * Roundness# / 100#

            'Add child Graphics
            Dim grfChild As Object
            Dim X0#, Y0#, X1#, Y1#, T#
            With grfThis.Vertices
                X0# = .Item(0).X
                Y0# = .Item(0).Y
                X1# = .Item(1).X
                Y1# = .Item(1).Y
                'Make sure X0 < X1
                If (X0# > X1#) Then
                    T# = X0#
                    X0# = X1#
                    X1# = T#
                End If
                'Make sure Y0 < Y1
                If (Y0# > Y1#) Then
                    T# = Y0#
                    Y0# = Y1#
                    Y1# = T#
                End If
            End With
            If R# = 0# Then
                'No rounded corners
                'All children are cosmetic
                Set grfChild = grfThis.Graphics.Add(gkGraphic)
                grfChild.Cosmetic = True
                'Now add vertices to the child
                With grfChild.Vertices
                    .Add X0#, Y0#, 0
                    .Add X0#, Y1#, 0, True
                    .Add X1#, Y1#, 0, True
                    .Add X1#, Y0#, 0, True
                    'Close the rectangle
                    .AddClose PenDown:=True 'PenDown
                End With
            Else
                'Rounded corners
                'We'll make 4 line children and 4 arc children
                'First line
                'All children are cosmetic
                Set grfChild = grfThis.Graphics.Add(gkGraphic)
                grfChild.Cosmetic = True
                'Now add vertices to the child
                With grfChild.Vertices
                    .Add X0# + R#, Y0#, 0
                    .Add X1# - R#, Y0#, 0, True
                End With
                'First arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet X1# - R#, Y0# + R#, 0#, R#, , 1.5 * Pi#, 0#
                'Second line
                Set grfChild = grfThis.Graphics.Add(gkGraphic)
                grfChild.Cosmetic = True
                With grfChild.Vertices
                    .Add X1#, Y0# + R#, 0
                    .Add X1#, Y1# - R#, 0, True
                End With
                'Second arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet X1# - R#, Y1# - R#, 0#, R#, , 0#, 0.5 * Pi#
                'Third line
                Set grfChild = grfThis.Graphics.Add(gkGraphic)
                grfChild.Cosmetic = True
                With grfChild.Vertices
                    .Add X1# - R#, Y1#, 0
                    .Add X0# + R#, Y1#, 0, True
                End With
                'Third arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet X0# + R#, Y1# - R#, 0#, R#, , 0.5 * Pi#, Pi#
                'Fourth line
                Set grfChild = grfThis.Graphics.Add(gkGraphic)
                grfChild.Cosmetic = True
                With grfChild.Vertices
                    .Add X0#, Y1# - R#, 0
                    .Add X0#, Y0# + R#, 0, True
                End With
                'Fourth arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet X0# + R#, Y0# + R#, 0#, R#, , Pi#, 1.5 * Pi#
            End If

            'Add visible child Graphics
        End If

        grfThis.RegenUnlock
        'grfThis.Application.PopVertexDefaults
        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:
        'grfThis.Application.PopVertexDefaults

        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function


Examples - Rounded Rectangle Regen - RRect.frm

RRect.frm

Rounded Rectangle Regen Example

VERSION 5.00
Begin VB.Form frmRRect
   Caption         =   "Round Rectangle"
   ClientHeight    =   1470
   ClientLeft      =   6435
   ClientTop       =   2910
   ClientWidth     =   3465
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   1470
   ScaleWidth      =   3465
   Begin VB.TextBox txtRoundness
      Height          =   285
      Left            =   1680
      TabIndex        =   3
      Text            =   "50"
      Top             =   240
      Width           =   615
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   840
      Width           =   1335
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   1920
      TabIndex        =   1
      Top             =   840
      Width           =   1215
   End
   Begin VB.Label Label1
      Caption         =   "Roundness"
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   240
      Width           =   1095
   End
End
Attribute VB_Name = "frmRRect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Me.Hide
End Sub


Examples - Rounded Rectangle Regen - CREATERR.BAS

CREATERR.BAS

Rounded Rectangle Regen Example

'Script to create RRect Turbo Shape and add it to a TurboCAD drawing
Global Const gkGRAPHIC = &H0B
sub Main()
    Dim g As Long
    Dim r As Long
    Dim v As Long

    Dim e As String

    'Create a graphic with kind = gkGraphic and Regen Method
    'RRect.Rectangle.  TCWGraphicCreate will cause OnNewGraphic
    'to be called
    g = TCWGraphicCreate(gkGraphic, "RoundRect.Rectangle")

    'if we got an error, display error message and stop
    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
        stop
    end if

    'Need up update properties to get RegenGraphic to be called
    e = TCWGraphicPropertySet(g, "PenColor", &H00FF0000)

    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if

    'Add the graphic to the drawing
    TCWGraphicAppend 0, g

    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if

    'Force the graphic to be drawn on the drawing
    TCWGraphicDraw g, 0
    if (TCWLastErrorGet(e) <> 0) Then
        msgbox e
    end if
end Sub


Examples - Text Box Regen - Box.bas

Box.bas

Text Box Regen Example

Attribute VB_Name = "modTextBox"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' DLL Entry point
Sub Main()

End Sub


Examples - Text Box Regen - Box.cls

Box.cls

Text Box Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Box"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2000                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idRoundness = 1
Const idText = 2

'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 2
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "TextBox"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{D25185FF-6A20-11d0-A115-00A024158DAF}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
    Names(0) = "Roundness"
    Types(0) = typeDouble
    IDs(0) = idRoundness
    Defaults(0) = 20

    Names(1) = "strText"
    Types(1) = typeString
    IDs(1) = idText
    Defaults(1) = "Unknown"

    GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmTextBox
    Names(0) = frmTextBox.Caption
    Unload frmTextBox

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
    GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed

        Dim Roundness#
        Dim StrText$
        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmTextBox
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next

                'When the property page is closed, transfer the numeric
                'roundness value from the TextBox to the Graphic
                'Get the value as a double-precision number
                Roundness# = CDbl(.txtRoundness.Text)
                'Make sure it's between 0 and 100
                If Roundness# < 0# Then Roundness# = 0#
                If Roundness# > 100# Then Roundness# = 100#
                'Set the roundness property value in the Graphic
                Graphic.Properties("Roundness") = Roundness#

                StrText = .StrText.Text
                Graphic.Properties("strText") = StrText

            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmTextBox
            With frmTextBox
                'If more than one RRect is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                'roundness value from the Graphic to the TextBox
                'Get the roundness property value from the Graphic
                Roundness# = Graphic.Properties("Roundness")
                'Set the TextBox control's text
                .txtRoundness.Text = Roundness#
                StrText = Graphic.Properties("strText")
                .StrText.Text = StrText

NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmTextBox
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmTextBox
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If

    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "lower left" corner i=0
    grfThis.Vertices.Add 0#, 0, 0#, False, True, False, True, False
    'Second Vertex is "upper right" corner i=1
    grfThis.Vertices.Add 2#, 1, 0#, False, True, False, True, False
'    Middle vertices
    ' i=2
    grfThis.Vertices.Add 1#, 0#, 0#, False, False, True, True, True
    ' i=3
    grfThis.Vertices.Add 2#, 0.5, 0#, False, False, True, True, True
    ' i=4
    grfThis.Vertices.Add 1#, 1#, 0#, False, False, True, True, True
    ' i=5
    grfThis.Vertices.Add 0#, 0.5, 0#, False, False, True, True, True
    grfThis.Properties("LimitVertices") = 6
    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis1 As Object)
        'Setup error handler
        On Error GoTo Failed
Dim StrText$
Dim grfThis As Graphic
        Set grfThis = grfThis1
        'Set up lock (prevent recursion)
        Dim LockCount&
        LockCount& = grfThis.RegenLock

        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
            'Delete any previous cosmetic children
            grfThis.Graphics.Clear gfCosmetic

            'Calculate height, width and radius of corners
            Dim W#, H#, R#, Roundness#
            Dim L#
            Dim Round#
                Round = grfThis.Properties("Roundness")
                Roundness = CDbl(Round)

                StrText = grfThis.Properties("strText")

            'Add child Graphics
            Dim grfChild As Graphic
            Dim x0#, y0#, x1#, y1#, T#
            With grfThis.Vertices
                x0 = .Item(0).X
                y0 = .Item(0).Y
                x1 = .Item(1).X
                y1 = .Item(1).Y
                W# = Abs(x1 - x0)
                H# = Abs(y1 - y0)
            End With

            If Roundness = 0# Then
                'No rounded corners
                'All children are cosmetic
                Set grfChild = grfThis.Graphics.Add(11)
                grfChild.Cosmetic = True
                'Now add vertices to the child
                With grfChild.Vertices
                    .Add x0#, y0#, 0
                    .Add x0#, y1#, 0, True
                    .Add x1#, y1#, 0, True
                    .Add x1#, y0#, 0, True
                    'Close the rectangle
                    .AddClose True 'PenDown
                End With
            Else

Dim Htext#

Dim x3#, x2#, y3#, y2#
                Set grfChild = grfThis.Graphics.AddText(StrText, (x0 + x1) / 2#, y1, 0, y1 - y0, 0, 0, , 2)
                grfChild.Cosmetic = True
                grfChild.Properties.Item("TextMode").Value = 2
                x3 = grfChild.Vertices.Item(3).X
                x2 = grfChild.Vertices.Item(2).X
Dim Matr As Matrix
                Set Matr = grfChild.Scale(0.95 * (x1 - x0) / (x3 - x2), 1, 1)
            With grfThis.Vertices
                 .Item(2).X = (x1 + x0) / 2#
                 .Item(2).Y = y0

                 .Item(3).X = x1
                 .Item(3).Y = (y1 + y0) / 2#

                 .Item(4).X = (x1 + x0) / 2#
                 .Item(4).Y = y1

                 .Item(5).X = x0
                 .Item(5).Y = (y1 + y0) / 2#
            End With

 H = Abs(y1 - y0)
 R = H / 2# * Roundness / 100#

                'Rounded corners
                'We'll make 4 line children and 4 arc children
                'First line
                'All children are cosmetic
                Set grfChild = grfThis.Graphics.Add(11)
                grfChild.Cosmetic = True
                'Now add vertices to the child
                With grfChild.Vertices
                    .Add x0# + R#, y0#, 0
                    .Add x1# - R#, y0#, 0, True
                End With
                'First arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet x1# - R#, y0# + R#, 0#, R#, , 1.5 * Pi#, 0#
                'Second line
                Set grfChild = grfThis.Graphics.Add(11)
                grfChild.Cosmetic = True
                With grfChild.Vertices
                    .Add x1#, y0# + R#, 0
                    .Add x1#, y1# - R#, 0, True
                End With
                'Second arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet x1# - R#, y1# - R#, 0#, R#, , 0#, 0.5 * Pi#
                'Third line
                Set grfChild = grfThis.Graphics.Add(11)
                grfChild.Cosmetic = True
                With grfChild.Vertices
                    .Add x1# - R#, y1#, 0
                    .Add x0# + R#, y1#, 0, True
                End With
                'Third arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet x0# + R#, y1# - R#, 0#, R#, , 0.5 * Pi#, Pi#
                'Fourth line
                Set grfChild = grfThis.Graphics.Add(11)
                grfChild.Cosmetic = True
                With grfChild.Vertices
                    .Add x0#, y1# - R#, 0
                    .Add x0#, y0# + R#, 0, True
                End With
                'Fourth arc
                Set grfChild = grfThis.Graphics.Add(gkArc)
                grfChild.Cosmetic = True
                grfChild.ArcSet x0# + R#, y0# + R#, 0#, R#, , Pi#, 1.5 * Pi#
            End If
        grfThis.RegenUnlock

            'Add visible child Graphics
        End If

        grfThis.RegenUnlock

        'grfThis.Application.PopVertexDefaults
        Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

Failed:
        'grfThis.Application.PopVertexDefaults

        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function


Examples - Text Box Regen - box.frm

box.frm

Text Box Regen Example

VERSION 5.00
Begin VB.Form frmTextBox
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Text Box"
   ClientHeight    =   2475
   ClientLeft      =   6420
   ClientTop       =   2895
   ClientWidth     =   3480
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   2475
   ScaleWidth      =   3480
   Begin VB.TextBox StrText
      Height          =   615
      Left            =   360
      MultiLine       =   -1  'True
      TabIndex        =   5
      Top             =   1080
      Width           =   2415
   End
   Begin VB.TextBox txtRoundness
      Height          =   285
      Left            =   1680
      TabIndex        =   3
      Text            =   "50"
      Top             =   240
      Width           =   615
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   2040
      Width           =   1335
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   1920
      TabIndex        =   1
      Top             =   2040
      Width           =   1215
   End
   Begin VB.Label Label2
      Caption         =   "Input Text"
      Height          =   252
      Left            =   1080
      TabIndex        =   4
      Top             =   840
      Width           =   1092
   End
   Begin VB.Label Label1
      Caption         =   "Roundness"
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   240
      Width           =   1095
   End
End
Attribute VB_Name = "frmTextBox"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Me.Hide
End Sub


Examples - Welding Symbol Regen - TailReference.frm

TailReference.frm

Welding Symbol Regen Example

VERSION 5.00
Begin VB.Form TailReference
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Specification,process and other reference."
   ClientHeight    =   2796
   ClientLeft      =   36
   ClientTop       =   264
   ClientWidth     =   4320
   LinkTopic       =   "Form4"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2796
   ScaleWidth      =   4320
   StartUpPosition =   3  'Windows Default
   Begin VB.ListBox List1
      Height          =   624
      Left            =   720
      TabIndex        =   4
      Top             =   1920
      Width           =   1212
   End
   Begin VB.CommandButton CmdCancel
      Caption         =   "Cancel"
      Height          =   372
      Left            =   2760
      TabIndex        =   3
      Top             =   2280
      Width           =   1092
   End
   Begin VB.CommandButton CmdOK
      Caption         =   "Ok"
      Height          =   372
      Left            =   2760
      TabIndex        =   2
      Top             =   1800
      Width           =   1092
   End
   Begin VB.TextBox TextTail
      Height          =   1212
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   0
      Top             =   240
      Width           =   3852
   End
   Begin VB.Label Label1
      AutoSize        =   -1  'True
      Caption         =   "Standard Letter Designations"
      Height          =   192
      Left            =   240
      TabIndex        =   1
      Top             =   1680
      Width           =   2076
   End
End
Attribute VB_Name = "TailReference"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CmdCancel_Click()
    Me.Hide
End Sub

Private Sub CmdOK_Click()
    NewTextTail = TextTail.Text
    Me.Hide
End Sub

Private Sub Form_Load()
Dim i As Long
    For i = 5000 To 5093
        List1.AddItem LoadResString(i)
    Next i
End Sub

Private Sub List1_Click()
Dim MainText$
Dim ListText$
    MainText = TextTail.Text
    ListText = List1.Text
    TextTail.Text = MainText & ListText

End Sub


Examples - Welding Symbol Regen - Weld.bas

Weld.bas

Welding Symbol Regen Example

Attribute VB_Name = "modWeld"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

Global Im1 As String
Global Im11 As String
Global Im2 As String
Global Im3 As String
Global Im31 As String
Global Im As Integer
Global NewTextTail As String

' DLL Entry point
Sub Main()
End Sub


Examples - Welding Symbol Regen - WeldBotSymbols.frm

WeldBotSymbols.frm

Welding Symbol Regen Example

VERSION 5.00
Begin VB.Form frmWeldBotSymbols
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Symbols"
   ClientHeight    =   1155
   ClientLeft      =   30
   ClientTop       =   270
   ClientWidth     =   2250
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1155
   ScaleWidth      =   2250
   StartUpPosition =   3  'Windows Default
   Begin VB.Image ImNone
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   0
      Stretch         =   -1  'True
      ToolTipText     =   "None"
      Top             =   0
      Width           =   372
   End
   Begin VB.Image ImV_Groove
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1800
      Stretch         =   -1  'True
      ToolTipText     =   "V-Groove Symbol"
      Top             =   360
      Width           =   372
   End
   Begin VB.Image ImU_Groove
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1800
      Stretch         =   -1  'True
      ToolTipText     =   "U-Groove Symbol"
      Top             =   0
      Width           =   372
   End
   Begin VB.Image ImSurfacing
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1440
      Stretch         =   -1  'True
      ToolTipText     =   "Surfacing Symbol"
      Top             =   720
      Width           =   372
   End
   Begin VB.Image ImSquare
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1440
      Stretch         =   -1  'True
      ToolTipText     =   "Square Symbol"
      Top             =   360
      Width           =   372
   End
   Begin VB.Image ImSpot
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1440
      Stretch         =   -1  'True
      ToolTipText     =   "Spot/Projection Symbol"
      Top             =   0
      Width           =   372
   End
   Begin VB.Image ImSlot
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1080
      Stretch         =   -1  'True
      ToolTipText     =   "Plug or slot Symbol"
      Top             =   720
      Width           =   372
   End
   Begin VB.Image ImSeam
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1080
      Stretch         =   -1  'True
      ToolTipText     =   "Seam Symbol"
      Top             =   360
      Width           =   372
   End
   Begin VB.Image ImScarf
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1080
      Stretch         =   -1  'True
      ToolTipText     =   "Scarf Symbol"
      Top             =   0
      Width           =   372
   End
   Begin VB.Image ImPlug
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   720
      Stretch         =   -1  'True
      ToolTipText     =   "Arc spot or arc seam Symbol"
      Top             =   720
      Width           =   372
   End
   Begin VB.Image ImJ_Groove
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   360
      Stretch         =   -1  'True
      ToolTipText     =   "J-Groove Symbol"
      Top             =   720
      Width           =   372
   End
   Begin VB.Image ImFlare_V
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   0
      Stretch         =   -1  'True
      ToolTipText     =   "Flare-V Symbol"
      Top             =   720
      Width           =   372
   End
   Begin VB.Image ImFlare_Bevel
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   720
      Stretch         =   -1  'True
      ToolTipText     =   "Flare-Bevel Symbol"
      Top             =   360
      Width           =   372
   End
   Begin VB.Image ImFlange_Edge
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   360
      Stretch         =   -1  'True
      ToolTipText     =   "Flange_Edge Symbol"
      Top             =   360
      Width           =   372
   End
   Begin VB.Image ImFlange_Corner
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   0
      Stretch         =   -1  'True
      ToolTipText     =   "Flange-Corner Symbol"
      Top             =   360
      Width           =   372
   End
   Begin VB.Image ImFillet
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   720
      Stretch         =   -1  'True
      ToolTipText     =   "Fillet Symbol"
      Top             =   0
      Width           =   372
   End
   Begin VB.Image ImBevel_Groove
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   360
      Stretch         =   -1  'True
      ToolTipText     =   "Bevel-Groove Symbol"
      Top             =   0
      Width           =   372
   End
   Begin VB.Image ImBack
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1800
      Stretch         =   -1  'True
      ToolTipText     =   "Back Symbol"
      Top             =   720
      Width           =   372
   End
End
Attribute VB_Name = "frmWeldBotSymbols"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
    frmWeldBotSymbols.ImNone.Picture = LoadResPicture(1000, 0)
    frmWeldBotSymbols.ImBack.Picture = LoadResPicture(2001, 0)
    frmWeldBotSymbols.ImBevel_Groove.Picture = LoadResPicture(2002, 0)
    frmWeldBotSymbols.ImFillet.Picture = LoadResPicture(2003, 0)
    frmWeldBotSymbols.ImFlange_Corner.Picture = LoadResPicture(2004, 0)
    frmWeldBotSymbols.ImFlange_Edge.Picture = LoadResPicture(2005, 0)
    frmWeldBotSymbols.ImFlare_Bevel.Picture = LoadResPicture(2006, 0)
    frmWeldBotSymbols.ImFlare_V.Picture = LoadResPicture(2007, 0)
    frmWeldBotSymbols.ImJ_Groove.Picture = LoadResPicture(2008, 0)
    frmWeldBotSymbols.ImPlug.Picture = LoadResPicture(2009, 0)
    frmWeldBotSymbols.ImScarf.Picture = LoadResPicture(2010, 0)
    frmWeldBotSymbols.ImSeam.Picture = LoadResPicture(2011, 0)
    frmWeldBotSymbols.ImSlot.Picture = LoadResPicture(2012, 0)
    frmWeldBotSymbols.ImSpot.Picture = LoadResPicture(2013, 0)
    frmWeldBotSymbols.ImSquare.Picture = LoadResPicture(2014, 0)
    frmWeldBotSymbols.ImSurfacing.Picture = LoadResPicture(2015, 0)
    frmWeldBotSymbols.ImU_Groove.Picture = LoadResPicture(2016, 0)
    frmWeldBotSymbols.ImV_Groove.Picture = LoadResPicture(2017, 0)

End Sub

Private Sub ImBack_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2001, 0)
            Im3 = "ImBack"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2001, 0)
            Im31 = "ImBack"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

       Me.Hide
End Sub

Private Sub ImBevel_Groove_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2002, 0)
            Im3 = "ImBevel_Groove"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2002, 0)
            Im31 = "ImBevel_Groove"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

       Me.Hide
End Sub

Private Sub ImNone_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(1000, 0)
            Im3 = "ImNone"
            frmWeld.ImageBot1.Enabled = False
            frmWeld.ImageBot1.Picture = LoadResPicture(1000, 0)
            Im31 = "ImNone"
            frmWeld.Size_TrBot1.Text = ""
            frmWeld.Size_TrBot1.Enabled = False
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(1000, 0)
            Im31 = "ImNone"
            frmWeld.Size_TrBot1.Text = ""
            frmWeld.Size_TrBot1.Enabled = False
        End If

        Me.Hide
End Sub

Private Sub ImFillet_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2003, 0)
            Im3 = "ImFillet"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2003, 0)
            Im31 = "ImFillet"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImFlange_Corner_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2004, 0)
            Im3 = "ImFlange_Corner"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2004, 0)
            Im31 = "ImFlange_Corner"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImFlange_Edge_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2005, 0)
            Im3 = "ImFlange_Edge"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2005, 0)
            Im31 = "ImFlange_Edge"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImFlare_Bevel_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2006, 0)
            Im3 = "ImFlare_Bevel"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2006, 0)
            Im31 = "ImFlare_Bevel"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImFlare_V_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2007, 0)
            Im3 = "ImFlare_V"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2007, 0)
            Im31 = "ImFlare_V"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImJ_Groove_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2008, 0)
            Im3 = "ImJ_Groove"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2008, 0)
            Im31 = "ImJ_Groove"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImPlug_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2009, 0)
            Im3 = "ImPlug"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2009, 0)
            Im31 = "ImPlug"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImScarf_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2010, 0)
            Im3 = "ImScarf"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2010, 0)
            Im31 = "ImScarf"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImSeam_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2011, 0)
            Im3 = "ImSeam"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2011, 0)
            Im31 = "ImSeam"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImSlot_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2012, 0)
            Im3 = "ImSlot"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2012, 0)
            Im31 = "ImSlot"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImSpot_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2013, 0)
            Im3 = "ImSpot"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2013, 0)
            Im31 = "ImSpot"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImSquare_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2014, 0)
            Im3 = "ImSquare"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2014, 0)
            Im31 = "ImSquare"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImSurfacing_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2015, 0)
            Im3 = "ImSurfacing"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2015, 0)
            Im31 = "ImSurfacing"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImU_Groove_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2016, 0)
            Im3 = "ImU_Groove"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2016, 0)
            Im31 = "ImU_Groove"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImV_Groove_Click()
        If Im = 3 Then
            frmWeld.ImageBot.Picture = LoadResPicture(2017, 0)
            Im3 = "ImV_Groove"
            frmWeld.ImageBot1.Enabled = True
        End If
        If Im = 31 Then
            frmWeld.ImageBot1.Picture = LoadResPicture(2017, 0)
            Im31 = "ImV_Groove"
            frmWeld.Size_TrBot1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub


Examples - Welding Symbol Regen - Weld.cls

Weld.cls

Welding Symbol Regen Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ANSI"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
Private Declare Function TCWUndo Lib "TCAPI70.dll" (ByVal n As Long) As Long

Private PenCol As Long
Private PenWid As Double

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265
Const Eps = 0.000001
'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idLen_PitTop = 1
Const idLen_PitBot = 2
Const idSize_TrTop = 3
Const idSize_TrBot = 4
Const idGr_AngleTop = 5
Const idGr_AngleBot = 6
Const idTailText = 7
Const idTextHeight = 8
Const idWeldTail = 9
Const idWeldAround = 10
Const idWeldField = 11

Const idWeldLeader = 12
Const idWeldDirection = 13

Const idSymTypeTop = 51
Const idSymTypeMid = 52
Const idSymTypeBot = 53

Const idContourTop = 54
Const idContourBot = 55

Const idFinishTop = 56
Const idFinishBot = 57

Const idFill_DepthTop = 58
Const idFill_DepthBot = 59

Const idSize_TrTop1 = 70
Const idSize_TrBot1 = 71
Const idSymTypeTop1 = 72
Const idSymTypeBot1 = 73

Const idLeaderSize = 80
Const idIntermittent = 81
Const idFontText = 82
Const idLeaderType = 83

Const idExplodeScale = 101
Const idUnits = 102

'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 32
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "SDK_Weld"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{FDB6F1CA-9631-11d1-A40A-0000B465872B}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)

    Names(0) = "Len_PitTop"
    Types(0) = typeString
    IDs(0) = idLen_PitTop
    Defaults(0) = "11"

    Names(1) = "Len_PitBot"
    Types(1) = typeString
    IDs(1) = idLen_PitBot
    Defaults(1) = "11"

    Names(2) = "Size_TrTop"
    Types(2) = typeString
    IDs(2) = idSize_TrTop
    Defaults(2) = "11"

    Names(3) = "Size_TrBot"
    Types(3) = typeString
    IDs(3) = idSize_TrBot
    Defaults(3) = "11"

    Names(4) = "Gr_AngleTop"
    Types(4) = typeString
    IDs(4) = idGr_AngleTop
    Defaults(4) = "11"

    Names(5) = "Gr_AngleBot"
    Types(5) = typeString
    IDs(5) = idGr_AngleBot
    Defaults(5) = "11"

    Names(6) = "TailText"
    Types(6) = typeString
    IDs(6) = idTailText
    Defaults(6) = "AAC"

    Names(7) = "TextHeight"
    Types(7) = typeDouble
    IDs(7) = idTextHeight
    Defaults(7) = 0.25

    Names(8) = "WeldTail"
    Types(8) = typeInteger
    IDs(8) = idWeldTail
    Defaults(8) = 1

    Names(9) = "WeldAround"
    Types(9) = typeInteger
    IDs(9) = idWeldAround
    Defaults(9) = 1

    Names(10) = "WeldField"
    Types(10) = typeInteger
    IDs(10) = idWeldField
    Defaults(10) = 1

    '****************************************************
    Names(11) = "SymTypeTop"
    Types(11) = typeString
    IDs(11) = idSymTypeTop
    Defaults(11) = "ImFillet"

    Names(12) = "SymTypeMid"
    Types(12) = typeString
    IDs(12) = idSymTypeMid
    Defaults(12) = "ImNone"

    Names(13) = "SymTypeBot"
    Types(13) = typeString
    IDs(13) = idSymTypeBot
    Defaults(13) = "ImFillet"

    '****************************************************
    '****************************************************
    Names(14) = "ContourTop"
    Types(14) = typeString
    IDs(14) = idContourTop
    Defaults(14) = "None"

    Names(15) = "ContourBot"
    Types(15) = typeString
    IDs(15) = idContourBot
    Defaults(15) = "None"

    '****************************************************
    Names(16) = "FinishTop"
    Types(16) = typeString
    IDs(16) = idFinishTop
    Defaults(16) = "None"

    Names(17) = "FinishBot"
    Types(17) = typeString
    IDs(17) = idFinishBot
    Defaults(17) = "None"

    '****************************************************
    Names(18) = "Fill_DepthTop"
    Types(18) = typeString
    IDs(18) = idFill_DepthTop
    Defaults(18) = ""

    Names(19) = "Fill_DepthBot"
    Types(19) = typeString
    IDs(19) = idFill_DepthBot
    Defaults(19) = ""

    '****************************************************

    Names(20) = "ExplodeScale"
    Types(20) = typeDouble
    IDs(20) = idExplodeScale
    Defaults(20) = 1#

    Names(21) = "Units"
    Types(21) = typeString
    IDs(21) = idUnits
    Defaults(21) = ""

    '*******************************************************
    Names(22) = "SymTypeTop1"
    Types(22) = typeString
    IDs(22) = idSymTypeTop1
    Defaults(22) = "ImNone"

    Names(23) = "SymTypeBot1"
    Types(23) = typeString
    IDs(23) = idSymTypeBot1
    Defaults(23) = "ImNone"

    Names(24) = "Size_TrTop1"
    Types(24) = typeString
    IDs(24) = idSize_TrTop1
    Defaults(24) = ""

    Names(25) = "Size_TrBot1"
    Types(25) = typeString
    IDs(25) = idSize_TrBot1
    Defaults(25) = ""
 '**********************************************

    Names(26) = "WeldLeader"
    Types(26) = typeInteger
    IDs(26) = idWeldLeader
    Defaults(26) = 1

    Names(27) = "WeldDirection"
    Types(27) = typeInteger
    IDs(27) = idWeldDirection
    Defaults(27) = 1
 '**********************************************

    Names(28) = "LeaderSize"
    Types(28) = typeDouble
    IDs(28) = idLeaderSize
    Defaults(28) = 0.25

    Names(29) = "Intermittent"
    Types(29) = typeInteger
    IDs(29) = idIntermittent
    Defaults(29) = 0

    Names(30) = "FontText"
    Types(30) = typeString
    IDs(30) = idFontText
    Defaults(30) = "Times New Roman"

    Names(31) = "LeaderType"
    Types(31) = typeInteger
    IDs(31) = idLeaderType
    Defaults(31) = 1

'End Scale
    GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmWeld
    Names(0) = frmWeld.Caption
    Unload frmWeld

    StockPages = ppStockBrush + ppStockPen + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
    GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal grfThis As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed

Dim Gr As Graphic
        Set Gr = grfThis
Dim Space%
        Space = Gr.Drawing.Properties("TileMode") ' Modal or Paper space
Dim UnitName$
    If Space <> 1 Then
        UnitName = Gr.Drawing.Properties("PaperLinearUnitName")
    Else
        UnitName = Gr.Drawing.Properties("LinearUnitName")
    End If
'    UnitName = Gr.Properties("Units")

Dim WeldSel As Long, NumSel As Long, i As Long
    WeldSel = 1
    NumSel = Gr.Drawing.Selection.Count
    If NumSel > 1 Then
        WeldSel = 0
        For i = 0 To NumSel - 1
            If Gr.Drawing.Selection(i).Type = "Welding.ANSI" Then
                WeldSel = WeldSel + 1
            End If
        Next i
    End If

Dim TextHeight#
Dim TailText$
Dim WeldTail% ' if Tail exist
Dim WeldAround% ' if Tail exist
Dim WeldField% ' if Tail exist
Dim SymTypeTop$
Dim SymTypeMid$
Dim SymTypeBot$
Dim SymTypeTop1$
Dim SymTypeBot1$
Dim Len_PitTop$, Len_PitBot$
Dim Size_TrTop1$, Size_TrBot1$
Dim Size_TrTop$, Size_TrBot$
Dim Gr_AngleTop$, Gr_AngleBot$
Dim SymDeg$
Dim ContourTop$, ContourBot$
Dim FinishTop$, FinishBot$
Dim Fill_DepthTop$, Fill_DepthBot$
Dim WeldLeader%, WeldDirection%
Dim LeaderSize#
Dim Intermittent%

        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmWeld
               'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next

                If UnitName = "in" Or UnitName = """" Or UnitName = "ft" Or UnitName = "'" Then
                    TextHeight = FractStringToNum(.HeightText.Text)
                    If TextHeight = 0 Then
                        TextHeight = StringToSize(.HeightText.Text)
                    End If
                Else
                    TextHeight = StringToSize(.HeightText.Text)
                End If

                If TextHeight > Eps And .HeightText.Text <> "" Then
                    Gr.Properties("TextHeight") = TextHeight
                End If

                LeaderSize = StringToSize(.LeaderSize.Text)
                On Error Resume Next
                If LeaderSize > Eps And .HeightText.Text <> "" Then
                    Gr.Properties("LeaderSize") = LeaderSize
                End If

                Intermittent = .Intermittent.Value
                On Error Resume Next
                If Intermittent <> 2 Then
                    Gr.Properties("Intermittent") = Intermittent
                End If

                WeldTail = .Check3.Value
                If WeldTail <> 2 Then
                    Gr.Properties("WeldTail") = WeldTail
                End If

                WeldDirection = .Direction.Value
                TailText = NewTextTail

                If WeldTail > 0 Then
                    If WeldSel > 1 And TailText = "" Then
                    Else
                        Gr.Properties("TailText") = TailText
                    End If
                Else
                    Gr.Properties("TailText") = ""
                End If

                WeldAround = .Check1.Value
                If WeldAround <> 2 Then
                    Gr.Properties("WeldAround") = WeldAround
                End If

                WeldField = .Check2.Value
                If WeldField <> 2 Then
                    Gr.Properties("WeldField") = WeldField
                End If

                WeldLeader = .Leader.Value
                If WeldLeader <> 2 Then
                    Gr.Properties("WeldLeader") = WeldLeader
                End If

                WeldDirection = .Direction.Value
                If WeldDirection <> 2 Then
                    Gr.Properties("WeldDirection") = WeldDirection
                End If
                If WeldSel = 1 Then
                    Gr.Properties("SymTypeTop") = Im1
                    Gr.Properties("SymTypeBot") = Im3
                    Gr.Properties("SymTypeTop1") = Im11
                    Gr.Properties("SymTypeBot1") = Im31
                    Gr.Properties("SymTypeMid") = Im2
                Else
                    If Im1 <> "ImNone" Then
                        Gr.Properties("SymTypeTop") = Im1
                    End If
                    If Im3 <> "ImNone" Then
                        Gr.Properties("SymTypeBot") = Im3
                    End If
                    If Im11 <> "ImNone" Then
                        Gr.Properties("SymTypeTop1") = Im11
                    End If
                    If Im31 <> "ImNone" Then
                        Gr.Properties("SymTypeBot1") = Im31
                    End If
                    If Im2 <> "ImNone" Then
                        If Im1 = "ImNone" And Im11 = "ImNone" And Im3 = "ImNone" And Im31 = "ImNone" Then
                            Gr.Properties("SymTypeMid") = Im2
                        Else
                            Gr.Properties("SymTypeMid") = "ImNone"
                        End If
                    End If
                End If

                ' Text Properties
                '*******************
                Len_PitTop = .Len_PitTop.Text
                If WeldSel > 1 And Len_PitTop = "" Then
                Else
                    Gr.Properties("Len_PitTop") = Len_PitTop
                End If

                Len_PitBot = .Len_PitBot.Text
                If WeldSel > 1 And Len_PitBot = "" Then
                Else
                    Gr.Properties("Len_PitBot") = Len_PitBot
                End If

                '*******************
                Size_TrTop = .Size_TrTop.Text
                If WeldSel > 1 And Size_TrTop = "" Then
                Else
                    Gr.Properties("Size_TrTop") = Size_TrTop
                End If

                Size_TrTop1 = .Size_TrTop1.Text
                If WeldSel > 1 And Size_TrTop1 = "" Then
                Else
                    Gr.Properties("Size_TrTop1") = Size_TrTop1
                End If

                Size_TrBot = .Size_TrBot.Text
                If WeldSel > 1 And Size_TrBot = "" Then
                Else
                    Gr.Properties("Size_TrBot") = Size_TrBot
                End If

                Size_TrBot1 = .Size_TrBot1.Text
                If WeldSel > 1 And Size_TrBot1 = "" Then
                Else
                    Gr.Properties("Size_TrBot1") = Size_TrBot1
                End If

                '*******************
                ' Groove Angle Symbol
Dim Deg$
                Deg = VBA.Chr(186)
                Gr_AngleTop = .Gr_AngleTop.Text
                SymDeg = .DegTop.Text
                If VBA.Left(SymDeg, 1) = Deg Then
                    Gr_AngleTop = Gr_AngleTop & VBA.Chr(186)
                Else
                    Gr_AngleTop = Gr_AngleTop & SymDeg
                End If
                If WeldSel > 1 And .Gr_AngleTop.Text = "" Then
                Else
                    Gr.Properties("Gr_AngleTop") = Gr_AngleTop
                End If

                Gr_AngleBot = .Gr_AngleBot.Text
                SymDeg = .DegBot.Text
                If VBA.Left(SymDeg, 1) = Deg Then
                    Gr_AngleBot = Gr_AngleBot & VBA.Chr(186)
                Else
                    Gr_AngleBot = Gr_AngleBot & SymDeg
                End If
                If WeldSel > 1 And .Gr_AngleBot.Text = "" Then
                Else
                    Gr.Properties("Gr_AngleBot") = Gr_AngleBot
                End If
                '*******************
                ' Contour Symbol

                ContourTop = .ContourTop.Text
                If WeldSel > 1 And ContourTop = "" Then
                Else
                    Gr.Properties("ContourTop") = ContourTop
                End If

                ContourBot = .ContourBot.Text
                If WeldSel > 1 And ContourBot = "" Then
                Else
                    Gr.Properties("ContourBot") = ContourBot
                End If
                '*******************
                ' Finish Symbol

                FinishTop = .FinishTop.Text
                If WeldSel > 1 And FinishTop = "" Then
                Else
                    Gr.Properties("FinishTop") = FinishTop
                End If

                FinishBot = .FinishBot.Text
                If WeldSel > 1 And FinishBot = "" Then
                Else
                    Gr.Properties("FinishBot") = FinishBot
                End If
                '*************************
                ' Depth of filling for Plug and Slot weld

                Fill_DepthTop = .Fill_DepthTop.Text
                If WeldSel > 1 And Fill_DepthTop = "" Then
                Else
                    Gr.Properties("Fill_DepthTop") = Fill_DepthTop
                End If

                Fill_DepthBot = .Fill_DepthBot.Text
                If WeldSel > 1 And Fill_DepthBot = "" Then
                Else
                    Gr.Properties("Fill_DepthBot") = Fill_DepthBot
                End If

             End With

        Else

Dim GrSet As GraphicSet
Dim SetCount As Long
'MsgBox (Gr.Drawing.Selection.Count)
            If Gr.Drawing.Selection.Count = 0 Then
                Set GrSet = Gr.Drawing.Graphics.QuerySet("Type=SDK_Weld")
                SetCount = GrSet.Count
                If SetCount > 1 Then
                    Set Gr = GrSet(SetCount - 2)
                End If
                GrSet.Clear
                Set GrSet = Nothing
            End If

            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmWeld
            With frmWeld
                'If more than one Rough-symbol is selected and they do not
                'have the same properties, don't set up this field
                On Error GoTo NoRType
                If WeldSel < 2 Then
                    TextHeight = Gr.Properties("TextHeight")
                    If UnitName = "in" Or UnitName = """" Or UnitName = "ft" Or UnitName = "'" Then
                        .HeightText.Text = NumToFractString(TextHeight)
                    Else
                        .HeightText.Text = CStr(TextHeight)
                    End If
                    .Units.Caption = " " & UnitName & " "
                     On Error Resume Next
                     LeaderSize = Gr.Properties("LeaderSize")
                    .LeaderSize.Text = CStr(LeaderSize)

                     On Error Resume Next
                     Intermittent = Gr.Properties("Intermittent")
                    .Intermittent.Value = Intermittent

                    TailText = Gr.Properties("TailText")
                    NewTextTail = Gr.Properties("TailText")
                    TailReference.TextTail.Text = TailText

                    WeldTail = Gr.Properties("WeldTail")
                    .Check3.Value = WeldTail

                    WeldAround = Gr.Properties("WeldAround")
                    .Check1.Value = WeldAround

                    WeldField = Gr.Properties("WeldField")
                    .Check2.Value = WeldField

                     WeldLeader = Gr.Properties("WeldLeader")
                    .Leader.Value = WeldLeader

                     WeldDirection = Gr.Properties("WeldDirection")
                    .Direction.Value = WeldDirection

                    ' Text Properties
                    '*******************
                    Len_PitTop = Gr.Properties("Len_PitTop")
                    .Len_PitTop.Text = Len_PitTop

                    Len_PitBot = Gr.Properties("Len_PitBot")
                    .Len_PitBot.Text = Len_PitBot

                    '*******************
                    Size_TrTop = Gr.Properties("Size_TrTop")
                    .Size_TrTop.Text = Size_TrTop

                    Size_TrTop1 = Gr.Properties("Size_TrTop1")
                    .Size_TrTop1.Text = Size_TrTop1

                    Size_TrBot = Gr.Properties("Size_TrBot")
                    .Size_TrBot.Text = Size_TrBot

                    Size_TrBot1 = Gr.Properties("Size_TrBot1")
                    .Size_TrBot1.Text = Size_TrBot1
                    '*******************
                    ' Groove Angle Symbol

                    Deg = VBA.Chr(186)
                    Gr_AngleTop = Gr.Properties("Gr_AngleTop")
                    If VBA.Right(Gr_AngleTop, 1) = Deg Then
                        .DegTop.Text = VBA.Chr(186)
                        .Gr_AngleTop.Text = VBA.Left(Gr_AngleTop, VBA.Len(Gr_AngleTop) - 1)

                    Else
                        .DegTop.Text = ""
                        .Gr_AngleTop.Text = Gr_AngleTop
                    End If

                    Gr_AngleBot = Gr.Properties("Gr_AngleBot")
                    If VBA.Right(Gr_AngleBot, 1) = Deg Then
                        .DegBot.Text = VBA.Chr(186)
                        .Gr_AngleBot.Text = VBA.Left(Gr_AngleBot, VBA.Len(Gr_AngleBot) - 1)
                    Else
                        .DegBot.Text = ""
                        .Gr_AngleBot.Text = Gr_AngleBot
                    End If
                    '*******************

                    ' Contour Symbol
                    ContourTop = Gr.Properties("ContourTop")
                    .ContourTop.Text = ContourTop

                    ContourBot = Gr.Properties("ContourBot")
                    .ContourBot.Text = ContourBot
                    '*******************

                    ' Finish Symbol
                    FinishTop = Gr.Properties("FinishTop")
                    .FinishTop.Text = FinishTop

                    FinishBot = Gr.Properties("FinishBot")
                    .FinishBot.Text = FinishBot
                   '*********************************

                    ' Depth of filling for Plug and Slot weld
                    Fill_DepthTop = Gr.Properties("Fill_DepthTop")
                    .Fill_DepthTop.Text = Fill_DepthTop

                    Fill_DepthBot = Gr.Properties("Fill_DepthBot")
                    .Fill_DepthBot.Text = Fill_DepthBot

    ' ******************************************************
                    'Top Image
                    SymTypeTop = Gr.Properties("SymTypeTop")
                    If SymTypeTop = "ImNone" Then
                        Im1 = "ImNone"
                        .ImageTop.Picture = LoadResPicture(1000, 0)
                        Im11 = "ImNone"
                        .ImageTop1.Picture = LoadResPicture(1000, 0)
                        .ImageTop1.Enabled = False
                        Gr.Properties("SymTypeTop1") = "ImNone"
                        .Size_TrTop1.Text = ""
                        .Size_TrTop1.Enabled = False
                    Else
                        .ImageTop1.Enabled = True
                        .Size_TrTop1.Enabled = True
                    End If
                    If SymTypeTop = "ImBack" Then
                        Im1 = "ImBack"
                        .ImageTop.Picture = LoadResPicture(1001, 0)
                    End If
                    If SymTypeTop = "ImBevel_Groove" Then
                        Im1 = "ImBevel_Groove"
                        .ImageTop.Picture = LoadResPicture(1002, 0)
                    End If
                    If SymTypeTop = "ImFillet" Then
                        Im1 = "ImFillet"
                        .ImageTop.Picture = LoadResPicture(1003, 0)
                    End If
                    If SymTypeTop = "ImFlange_Corner" Then
                        Im1 = "ImFlange_Corner"
                        .ImageTop.Picture = LoadResPicture(1004, 0)
                    End If
                    If SymTypeTop = "ImFlange_Edge" Then
                        Im1 = "ImFlange_Edge"
                        .ImageTop.Picture = LoadResPicture(1005, 0)
                    End If
                    If SymTypeTop = "ImFlare_Bevel" Then
                        Im1 = "ImFlare_Bevel"
                        .ImageTop.Picture = LoadResPicture(1006, 0)
                    End If
                    If SymTypeTop = "ImFlare_V" Then
                        Im1 = "ImFlare_V"
                        .ImageTop.Picture = LoadResPicture(1007, 0)
                    End If
                    If SymTypeTop = "ImJ_Groove" Then
                        Im1 = "ImJ_Groove"
                        .ImageTop.Picture = LoadResPicture(1008, 0)
                    End If
                    If SymTypeTop = "ImPlug" Then
                        Im1 = "ImPlug"
                        .ImageTop.Picture = LoadResPicture(1009, 0)
                    End If
                    If SymTypeTop = "ImScarf" Then
                        Im1 = "ImScarf"
                        .ImageTop.Picture = LoadResPicture(1010, 0)
                    End If
                    If SymTypeTop = "ImSeam" Then
                        Im1 = "ImSeam"
                        .ImageTop.Picture = LoadResPicture(1011, 0)
                    End If
                    If SymTypeTop = "ImSlot" Then
                        Im1 = "ImSlot"
                        .ImageTop.Picture = LoadResPicture(1012, 0)
                    End If
                    If SymTypeTop = "ImSpot" Then
                        Im1 = "ImSpot"
                        .ImageTop.Picture = LoadResPicture(1013, 0)
                    End If
                    If SymTypeTop = "ImSquare" Then
                        Im1 = "ImSquare"
                        .ImageTop.Picture = LoadResPicture(1014, 0)
                    End If
                    If SymTypeTop = "ImSurfacing" Then
                        Im1 = "ImSurfacing"
                        .ImageTop.Picture = LoadResPicture(1015, 0)
                    End If
                    If SymTypeTop = "ImU_Groove" Then
                        Im1 = "ImU_Groove"
                        .ImageTop.Picture = LoadResPicture(1016, 0)
                    End If
                    If SymTypeTop = "ImV_Groove" Then
                        Im1 = "ImV_Groove"
                        .ImageTop.Picture = LoadResPicture(1017, 0)
                   End If

    ' ******************************************************
                    'Second Top Image
                    SymTypeTop1 = Gr.Properties("SymTypeTop1")
                    If SymTypeTop1 = "ImNone" Then
                        Im11 = "ImNone"
                        .ImageTop1.Picture = LoadResPicture(1000, 0)
                        .Size_TrTop1.Enabled = False
                    End If
                    If SymTypeTop1 = "ImBack" Then
                        Im11 = "ImBack"
                        .ImageTop1.Picture = LoadResPicture(1001, 0)
                    End If
                    If SymTypeTop1 = "ImBevel_Groove" Then
                        Im11 = "ImBevel_Groove"
                        .ImageTop1.Picture = LoadResPicture(1002, 0)
                    End If
                    If SymTypeTop1 = "ImFillet" Then
                        Im11 = "ImFillet"
                        .ImageTop1.Picture = LoadResPicture(1003, 0)
                    End If
                    If SymTypeTop1 = "ImFlange_Corner" Then
                        Im11 = "ImFlange_Corner"
                        .ImageTop1.Picture = LoadResPicture(1004, 0)
                    End If
                    If SymTypeTop1 = "ImFlange_Edge" Then
                        Im11 = "ImFlange_Edge"
                        .ImageTop1.Picture = LoadResPicture(1005, 0)
                    End If
                    If SymTypeTop1 = "ImFlare_Bevel" Then
                        Im11 = "ImFlare_Bevel"
                        .ImageTop1.Picture = LoadResPicture(1006, 0)
                    End If
                    If SymTypeTop1 = "ImFlare_V" Then
                        Im11 = "ImFlare_V"
                        .ImageTop1.Picture = LoadResPicture(1007, 0)
                    End If
                    If SymTypeTop1 = "ImJ_Groove" Then
                        Im11 = "ImJ_Groove"
                        .ImageTop1.Picture = LoadResPicture(1008, 0)
                    End If
                    If SymTypeTop1 = "ImPlug" Then
                        Im11 = "ImPlug"
                        .ImageTop1.Picture = LoadResPicture(1009, 0)
                    End If
                    If SymTypeTop1 = "ImScarf" Then
                        Im11 = "ImScarf"
                        .ImageTop1.Picture = LoadResPicture(1010, 0)
                    End If
                    If SymTypeTop1 = "ImSeam" Then
                        Im11 = "ImSeam"
                        .ImageTop1.Picture = LoadResPicture(1011, 0)
                    End If
                    If SymTypeTop1 = "ImSlot" Then
                        Im11 = "ImSlot"
                        .ImageTop1.Picture = LoadResPicture(1012, 0)
                    End If
                    If SymTypeTop1 = "ImSpot" Then
                        Im11 = "ImSpot"
                        .ImageTop1.Picture = LoadResPicture(1013, 0)
                    End If
                    If SymTypeTop1 = "ImSquare" Then
                        Im11 = "ImSquare"
                        .ImageTop1.Picture = LoadResPicture(1014, 0)
                    End If
                    If SymTypeTop1 = "ImSurfacing" Then
                        Im11 = "ImSurfacing"
                        .ImageTop1.Picture = LoadResPicture(1015, 0)
                    End If
                    If SymTypeTop1 = "ImU_Groove" Then
                        Im11 = "ImU_Groove"
                        .ImageTop1.Picture = LoadResPicture(1016, 0)
                    End If
                    If SymTypeTop1 = "ImV_Groove" Then
                        Im11 = "ImV_Groove"
                        .ImageTop1.Picture = LoadResPicture(1017, 0)
                   End If

    ' ******************************************************

    ' ******************************************************
                    ' Bottom Image
                    SymTypeBot = Gr.Properties("SymTypeBot")
                    If SymTypeBot = "ImNone" Then
                        Im3 = "ImNone"
                        .ImageBot.Picture = LoadResPicture(1000, 0)
                        .ImageBot1.Enabled = False
                        Gr.Properties("SymTypeBot1") = "ImNone"
                        .Size_TrBot1.Text = ""
                        .Size_TrBot1.Enabled = False
                    Else
                        .ImageBot1.Enabled = True
                        .Size_TrBot1.Enabled = True
                    End If
                    If SymTypeBot = "ImBack" Then
                        Im3 = "ImBack"
                        .ImageBot.Picture = LoadResPicture(2001, 0)
                    End If
                    If SymTypeBot = "ImBevel_Groove" Then
                        Im3 = "ImBevel_Groove"
                        .ImageBot.Picture = LoadResPicture(2002, 0)
                    End If
                    If SymTypeBot = "ImFillet" Then
                        Im3 = "ImFillet"
                        .ImageBot.Picture = LoadResPicture(2003, 0)
                    End If
                    If SymTypeBot = "ImFlange_Corner" Then
                        Im3 = "ImFlange_Corner"
                        .ImageBot.Picture = LoadResPicture(2004, 0)
                    End If
                    If SymTypeBot = "ImFlange_Edge" Then
                        Im3 = "ImFlange_Edge"
                        .ImageBot.Picture = LoadResPicture(2005, 0)
                    End If
                    If SymTypeBot = "ImFlare_Bevel" Then
                        Im3 = "ImFlare_Bevel"
                        .ImageBot.Picture = LoadResPicture(2006, 0)
                    End If
                    If SymTypeBot = "ImFlare_V" Then
                        Im3 = "ImFlare_V"
                        .ImageBot.Picture = LoadResPicture(2007, 0)
                    End If
                    If SymTypeBot = "ImJ_Groove" Then
                        Im3 = "ImJ_Groove"
                        .ImageBot.Picture = LoadResPicture(2008, 0)
                    End If
                    If SymTypeBot = "ImPlug" Then
                        Im3 = "ImPlug"
                        .ImageBot.Picture = LoadResPicture(2009, 0)
                    End If
                    If SymTypeBot = "ImScarf" Then
                        Im3 = "ImScarf"
                        .ImageBot.Picture = LoadResPicture(2010, 0)
                    End If
                    If SymTypeBot = "ImSeam" Then
                        Im3 = "ImSeam"
                        .ImageBot.Picture = LoadResPicture(2011, 0)
                    End If
                    If SymTypeBot = "ImSlot" Then
                        Im3 = "ImSlot"
                        .ImageBot.Picture = LoadResPicture(2012, 0)
                    End If
                    If SymTypeBot = "ImSpot" Then
                        Im3 = "ImSpot"
                        .ImageBot.Picture = LoadResPicture(2013, 0)
                    End If
                    If SymTypeBot = "ImSquare" Then
                        Im3 = "ImSquare"
                        .ImageBot.Picture = LoadResPicture(2014, 0)
                    End If
                    If SymTypeBot = "ImSurfacing" Then
                        Im3 = "ImSurfacing"
                        .ImageBot.Picture = LoadResPicture(2015, 0)
                    End If
                    If SymTypeBot = "ImU_Groove" Then
                        Im3 = "ImU_Groove"
                        .ImageBot.Picture = LoadResPicture(2016, 0)
                    End If
                    If SymTypeBot = "ImV_Groove" Then
                        Im3 = "ImV_Groove"
                        .ImageBot.Picture = LoadResPicture(2017, 0)
                    End If

    ' ******************************************************
    ' ******************************************************
                    ' Second Bottom Image
                    SymTypeBot1 = Gr.Properties("SymTypeBot1")
                    If SymTypeBot1 = "ImNone" Then
                        Im31 = "ImNone"
                        .ImageBot1.Picture = LoadResPicture(1000, 0)
                        .Size_TrBot1.Enabled = False
                    End If
                    If SymTypeBot1 = "ImBack" Then
                        Im31 = "ImBack"
                        .ImageBot1.Picture = LoadResPicture(2001, 0)
                    End If
                    If SymTypeBot1 = "ImBevel_Groove" Then
                        Im31 = "ImBevel_Groove"
                        .ImageBot1.Picture = LoadResPicture(2002, 0)
                    End If
                    If SymTypeBot1 = "ImFillet" Then
                        Im31 = "ImFillet"
                        .ImageBot1.Picture = LoadResPicture(2003, 0)
                    End If
                    If SymTypeBot1 = "ImFlange_Corner" Then
                        Im31 = "ImFlange_Corner"
                        .ImageBot1.Picture = LoadResPicture(2004, 0)
                    End If
                    If SymTypeBot1 = "ImFlange_Edge" Then
                        Im31 = "ImFlange_Edge"
                        .ImageBot1.Picture = LoadResPicture(2005, 0)
                    End If
                    If SymTypeBot1 = "ImFlare_Bevel" Then
                        Im31 = "ImFlare_Bevel"
                        .ImageBot1.Picture = LoadResPicture(2006, 0)
                    End If
                    If SymTypeBot1 = "ImFlare_V" Then
                        Im31 = "ImFlare_V"
                        .ImageBot1.Picture = LoadResPicture(2007, 0)
                    End If
                    If SymTypeBot1 = "ImJ_Groove" Then
                        Im31 = "ImJ_Groove"
                        .ImageBot1.Picture = LoadResPicture(2008, 0)
                    End If
                    If SymTypeBot1 = "ImPlug" Then
                        Im31 = "ImPlug"
                        .ImageBot1.Picture = LoadResPicture(2009, 0)
                    End If
                    If SymTypeBot1 = "ImScarf" Then
                        Im31 = "ImScarf"
                        .ImageBot1.Picture = LoadResPicture(2010, 0)
                    End If
                    If SymTypeBot1 = "ImSeam" Then
                        Im31 = "ImSeam"
                        .ImageBot1.Picture = LoadResPicture(2011, 0)
                    End If
                    If SymTypeBot1 = "ImSlot" Then
                        Im31 = "ImSlot"
                        .ImageBot1.Picture = LoadResPicture(2012, 0)
                    End If
                    If SymTypeBot1 = "ImSpot" Then
                        Im31 = "ImSpot"
                        .ImageBot1.Picture = LoadResPicture(2013, 0)
                    End If
                    If SymTypeBot1 = "ImSquare" Then
                        Im31 = "ImSquare"
                        .ImageBot1.Picture = LoadResPicture(2014, 0)
                    End If
                    If SymTypeBot1 = "ImSurfacing" Then
                        Im31 = "ImSurfacing"
                        .ImageBot1.Picture = LoadResPicture(2015, 0)
                    End If
                    If SymTypeBot1 = "ImU_Groove" Then
                        Im31 = "ImU_Groove"
                        .ImageBot1.Picture = LoadResPicture(2016, 0)
                    End If
                    If SymTypeBot1 = "ImV_Groove" Then
                        Im31 = "ImV_Groove"
                        .ImageBot1.Picture = LoadResPicture(2017, 0)
                    End If

    ' ******************************************************
                    'Mid Image
                    SymTypeMid = Gr.Properties("SymTypeMid")
                    If SymTypeMid = "ImNone" Then
                        Im2 = "ImNone"
                        .ImageMid.Picture = LoadResPicture(1000, 0)
                    End If
                    If SymTypeMid = "ImSeam" Then
                        Im2 = "ImSeam"
                        .ImageMid.Picture = LoadResPicture(3011, 0)
                        .Fill_DepthTop.Enabled = False
                        .Fill_DepthBot.Enabled = False
                        .Fill_DepthTop.Text = ""
                        .Fill_DepthBot.Text = ""
                    End If
                    If SymTypeMid = "ImSpot" Then
                        Im2 = "ImSpot"
                        .ImageMid.Picture = LoadResPicture(3013, 0)
                        .Fill_DepthTop.Text = ""
                        .Fill_DepthBot.Text = ""
                        .Fill_DepthTop.Enabled = False
                        .Fill_DepthBot.Enabled = False
                    End If
                Else
                    .HeightText.Text = ""
                    .Units.Caption = " " & UnitName & " "
                    .LeaderSize.Text = ""
                    .Intermittent.Value = 2
                    TailReference.TextTail.Text = ""
                    NewTextTail = ""
                    .Check3.Value = 2
                    .Check1.Value = 2
                    .Check2.Value = 2
                    .Leader.Value = 2
                    .Direction.Value = 2
                    .Len_PitTop.Text = ""
                    .Len_PitBot.Text = ""
                    .Size_TrTop.Text = ""
                    .Size_TrTop1.Text = ""
                    .Size_TrBot.Text = ""
                    .Size_TrBot1.Text = ""
                    .DegTop.Text = ""
                    .Gr_AngleTop.Text = ""
                    .DegBot.Text = ""
                    .Gr_AngleBot.Text = ""
                    .ContourTop.Text = ""
                    .ContourBot.Text = ""
                    .FinishTop.Text = ""
                    .FinishBot.Text = ""
                    .Fill_DepthTop.Text = ""
                    .Fill_DepthBot.Text = ""
                    .ImageTop.Picture = LoadResPicture(1000, 0)
                    Im1 = "ImNone"
                    .ImageTop1.Picture = LoadResPicture(1000, 0)
                    Im11 = "ImNone"
                    .ImageBot.Picture = LoadResPicture(1000, 0)
                    Im3 = "ImNone"
                    .ImageBot1.Picture = LoadResPicture(1000, 0)
                    Im31 = "ImNone"
                    .ImageMid.Picture = LoadResPicture(1000, 0)
                    Im2 = "ImNone"
                End If
NoRType:
             End With
            Set Gr = grfThis
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
'            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmWeld
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmWeld
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If
    On Error GoTo Failed
    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    'First Vertex is "lower left" corner
    grfThis.Vertices.Add -0.5, -1#, 0#, False, True, False, True, False
    grfThis.Vertices.Add -1, -0.5, 0#, False, False, False, True, True
    grfThis.Vertices.Add 0#, 0#, 0#, False, False, False, True, False
    grfThis.Vertices.Add 2#, 0#, 0#, False, False, False, False
    grfThis.Properties("LimitVertices") = True
    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis As Object)
        'Setup error handler
'MsgBox ("Regen")
Dim Gr As Graphic

Dim GrChild As Graphic
        Set Gr = grfThis
        On Error GoTo Failed

        'Set up lock (prevent recursion)
        Dim LockCount&
        LockCount& = Gr.RegenLock

        'Setup error handler (make sure lock is removed)
        On Error GoTo FailedLock
        If LockCount& = 0 Then
        '****************************************
        ' Research space Units
Dim UnitScale#
Dim Space%
            Space = Gr.Drawing.Properties("TileMode") ' Modal or Paper space
Dim UnitName$
            If Space <> 1 Then
                UnitName = Gr.Drawing.Properties("PaperLinearUnitName")
            Else
                UnitName = Gr.Drawing.Properties("LinearUnitName")
            End If

Dim UnitNameOld$
            UnitNameOld = Gr.Properties("Units")
Dim x0#, y0#, x1#, y1#, x2#, y2#, x3#, y3#
Dim iLast As Long, iBase As Long, j As Long
Dim VersCount As Long
            With Gr.Vertices
'MsgBox (Gr.Properties("WeldLeader"))
                VersCount = .Count
'MsgBox ("VersCount=" & CStr(VersCount))
                If Gr.Properties("WeldLeader") = 1 Then
                    Gr.Properties("LimitVertices") = True
                Else
                    Gr.Properties("LimitVertices") = False
                    If VersCount < 4 Then
                        Beep
                        TCWUndo 1
GoTo RRR
Dim CosmCount#, CosmPoly As Graphic, xj#, yj#
                        CosmCount = Gr.Graphics.Count
                        For j = 0 To CosmCount - 1
                            Set CosmPoly = Gr.Graphics(j)
                            If CosmPoly.Type = "GRAPHIC" Then
                                If CosmPoly.Properties("Info") = "CosmPoly" Then
                                    Exit For
                                End If
                            End If
                        Next j
Dim nVCosm As Long, Ver As Vertex, Verj As Vertex
                        nVCosm = CosmPoly.Vertices.Count
                        .Add 0, 0, 0, False
                        For j = 0 To nVCosm - 1
                            xj = CosmPoly.Vertices(j).x
                            yj = CosmPoly.Vertices(j).y
                            .Item(j).x = xj
                            .Item(j).y = yj
                            If j = nVCosm - 1 Then
                                .Item(j).PenDown = False
                                .Item(j).Editable = False
                            Else
                                .Item(j).PenDown = True
                                .Item(j).Editable = True
                            End If
                        Next j
RRR:
                    End If
                End If
                VersCount = .Count
                iLast = VersCount - 1
                iBase = VersCount - 2
            End With
            With Gr.Vertices
                x0 = .Item(0).x
                y0 = .Item(0).y
                x1 = .Item(1).x
                y1 = .Item(1).y
                x2 = .Item(iBase).x
                y2 = .Item(iBase).y
                x3 = .Item(iLast).x
                y3 = .Item(iLast).y
                .Item(iLast).y = y2
                y3 = y2
            End With
'MsgBox ("x2=" & CStr(x2))

            'If New graphic
Dim UnitScaleNew#
            UnitScaleNew = 1
'MsgBox ("UnitNameOld=" & CStr(UnitNameOld))

            If UnitNameOld = "" Then
                UnitScaleNew = UnitToUnit(UnitName, "in")
                If UnitScaleNew <> 1 Then
Dim Matr As Matrix
'MsgBox (UnitName & "  UnitScaleNew=" & CStr(UnitScaleNew))
                    Set Matr = Gr.Scale(UnitScaleNew, UnitScaleNew, 1, x2, y2, 0)
Dim TH#, LS#
                    TH = Gr.Properties("TextHeight")
                    Gr.Properties("TextHeight") = TH * UnitScaleNew
'                    LS = Gr.Properties("LeaderSize")
'                    Gr.Properties("LeaderSize") = LS * UnitScaleNew
                    Gr.Properties("LeaderSize") = TH * UnitScaleNew
                    Set Matr = Nothing
                End If
                UnitNameOld = UnitName
                With Gr.Vertices
                    x0 = .Item(0).x
                    y0 = .Item(0).y
                    x1 = .Item(1).x
                    y1 = .Item(1).y
                    x2 = .Item(iBase).x
                    y2 = .Item(iBase).y
                    x3 = .Item(iLast).x
                    y3 = .Item(iLast).y
                    .Item(iLast).y = y2
                    y3 = y2
                End With
            End If

            Gr.Properties("Units") = UnitName
            UnitScale = 1
            If UnitName <> UnitNameOld Then
Dim GrCount As Long
                GrCount = Gr.Graphics.Count
                With Gr.Graphics
                    For j = 0 To GrCount - 1
                        Set GrChild = .Item(j)
                        If GrChild.Type <> "DATA" And GrChild.Visible = False Then
Dim LL#, xx0#, yy0#, xx1#, yy1#
                            With GrChild.Vertices
                                xx0 = .Item(0).x
                                yy0 = .Item(0).y
                                xx1 = .Item(1).x
                                yy1 = .Item(1).y
                            End With
                            LL = Sqr((xx1 - xx0) * (xx1 - xx0) + (yy1 - yy0) * (yy1 - yy0))
                        End If
                    Next j
                End With

                If Abs(LL - 0.01) > 0.00001 Then
                    UnitScale = UnitToUnit(UnitName, UnitNameOld)
'MsgBox ("UnitScale=" & CStr(UnitScale) & "  a=" & CStr(a))
                End If
            End If

        '****************************************
        With Gr.Properties
            PenCol = .Item("PenColor")
            PenWid = .Item("PenWidth")

Dim TextHeight#
            TextHeight = .Item("TextHeight") * UnitScale
            If UnitName <> UnitNameOld Then
                .Item("TextHeight") = TextHeight
            End If
Dim LeaderSize#
            LeaderSize = 0
            On Error Resume Next
            LeaderSize = .Item("LeaderSize") * UnitScale
            If UnitName <> UnitNameOld Then
                On Error Resume Next
                .Item("LeaderSize") = LeaderSize
            End If
            .Item("LeaderSize") = TextHeight

Dim Intermittent%
            On Error Resume Next
            Intermittent = .Item("Intermittent")

Dim TailText$
            TailText = .Item("TailText")
Dim WeldTail%
            WeldTail = .Item("WeldTail")
Dim WeldAround%
            WeldAround = .Item("WeldAround")
Dim WeldField%
            WeldField = .Item("WeldField")
Dim WeldLeader%
            WeldLeader = .Item("WeldLeader")
Dim WeldDirection%
            WeldDirection = .Item("WeldDirection")

Dim SymTypeTop$
            SymTypeTop = .Item("SymTypeTop")
Dim SymTypeTop1$
            SymTypeTop1 = .Item("SymTypeTop1")
Dim SymTypeMid$
            SymTypeMid = .Item("SymTypeMid")
Dim SymTypeBot$
            SymTypeBot = .Item("SymTypeBot")
Dim SymTypeBot1$
            SymTypeBot1 = .Item("SymTypeBot1")

Dim Len_PitTop$, Len_PitBot$
            Len_PitTop = .Item("Len_PitTop")
            Len_PitBot = .Item("Len_PitBot")

Dim Size_TrTop$, Size_TrBot$
            Size_TrTop = .Item("Size_TrTop")
            Size_TrBot = .Item("Size_TrBot")
Dim Size_TrTop1$, Size_TrBot1$
            Size_TrTop1 = .Item("Size_TrTop1")
            Size_TrBot1 = .Item("Size_TrBot1")

Dim Gr_AngleTop$, Gr_AngleBot$
            Gr_AngleTop = .Item("Gr_AngleTop")
            Gr_AngleBot = .Item("Gr_AngleBot")
Dim ContourTop$, ContourBot$
            ContourTop = .Item("ContourTop")
            ContourBot = .Item("ContourBot")
Dim FinishTop$, FinishBot$
            FinishTop = .Item("FinishTop")
            FinishBot = .Item("FinishBot")
Dim Fill_DepthTop$, Fill_DepthBot$
            Fill_DepthTop = .Item("Fill_DepthTop")
            Fill_DepthBot = .Item("Fill_DepthBot")

        End With
        With Gr.Vertices
            If WeldDirection = 1 And x3 < x2 Then
                x1 = x2 + Abs(x2 - x1) * Sign(x3 - x2)
                x0 = x2 + Abs(x2 - x0) * Sign(x3 - x2)
                .Item(1).x = x1
                .Item(0).x = x0
            End If
            If WeldDirection <> 1 And x3 > x2 Then
                With Gr.Vertices
                    x0 = x2 + Abs(x2 - x0) * Sign(x3 - x2)
                    .Item(0).x = x0
                    For j = 1 To iBase - 1
                        xj = .Item(j).x
                        xj = x2 + Abs(x2 - xj) * Sign(x3 - x2)
                        .Item(j).x = xj
                    Next j
                End With
            End If

            If WeldDirection = 1 Then
                x3 = x2 + 1
            Else
                x3 = x2 - 1
            End If
            .Item(iLast).x = x3
            If WeldLeader = 1 Then
                x1 = x2
                y1 = y2
                .Item(iBase - 1).x = x1
                .Item(iBase - 1).y = y1
            Else
                If Abs(x1 - x2) < Eps And Abs(y1 - y2) < Eps Then
                    With Gr.Vertices
                        For j = 1 To iBase - 1
'                            x1 = (x0 + x2) / 2 + 0.5 * Sign(x2 - x3)
'                            y1 = (y0 + y2) / 2
'                            .Item(iBase - 1).x = x1
'                            .Item(iBase - 1).y = y1
                            xj = (x0 + x2) / 2 + 0.5 * Sign(x2 - x3)
                            yj = (y0 + y2) / 2
                            .Item(j).x = xj
                            .Item(j).y = yj
                        Next j
                    End With
                End If
            End If
        End With

        If Abs(TextHeight - LeaderSize) > Eps Then
Dim x0New#, y0New#, x1New#, y1New#
            x1New = x2 + (x1 - x2) * TextHeight / LeaderSize
            y1New = y2 + (y1 - y2) * TextHeight / LeaderSize
            x0New = x2 + (x0 - x2) * TextHeight / LeaderSize
            y0New = y2 + (y0 - y2) * TextHeight / LeaderSize
            With Gr.Vertices
                .Item(0).x = x0New
                .Item(0).y = y0New
                .Item(1).x = x1New
                .Item(1).y = y1New
            End With
            x0 = x0New
            y0 = y0New
            x1 = x1New
            y1 = y1New
        End If

        LeaderSize = TextHeight
            'Delete any previous cosmetic children
            Gr.Graphics.Clear gfCosmetic

            ' ****************************************************
            'Add visible child Graphics

Dim hText#, wText#, xcText#, ycText#, dx#, dy#
Dim L01#, sina#, cosa#, Bet#
Dim lPoint#, wPoint#
Dim RAround#
Dim wTail#
Dim hTailText#

        ' ************************************************
        ' ************************************************
        ' ************************************************
Dim xMid#, yMid#
            xMid = (x2 + x3) / 2
            yMid = (y2 + y3) / 2
Dim yMaxTop#, yMinBot#

            ' Add MiddleSymbol
Dim GrMidSym As Graphic
            If SymTypeTop = "ImNone" And SymTypeTop1 = "ImNone" And SymTypeBot = "ImNone" And SymTypeBot1 = "ImNone" Then
                Set GrMidSym = Nothing
                If SymTypeMid = "ImSeam" Then SeamSymbol Gr, GrMidSym, TextHeight
                If SymTypeMid = "ImSpot" Then Spot_ProjectionSymbol Gr, GrMidSym, TextHeight
                If GrMidSym Is Nothing Then

                Else
                    GrMidSym.MoveRelative xMid, yMid - TextHeight / 2, 0
                End If
            Else
                Gr.Properties("SymTypeMid") = "ImNone"
            End If
        ' Top Side
        ' Add Top Symbol
Dim GrTopSym As Graphic
            Set GrTopSym = Nothing
            If SymTypeTop = "ImBack" Then BackSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImBevel_Groove" Then Bevel_GrooveSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImFillet" Then FilletSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImFlange_Corner" Then Flange_CornerSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImFlange_Edge" Then Flange_EdgeSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImFlare_Bevel" Then Flare_BevelSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImFlare_V" Then Flare_VSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImJ_Groove" Then J_GrooveSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImPlug" Then PlugSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImScarf" Then ScarfSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImSeam" Then SeamSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImSlot" Then SlotSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImSpot" Then Spot_ProjectionSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImSquare" Then SquareSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImSurfacing" Then SurfacingSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImU_Groove" Then U_GrooveSymbol Gr, GrTopSym, TextHeight
            If SymTypeTop = "ImV_Groove" Then V_GrooveSymbol Gr, GrTopSym, TextHeight
            If GrTopSym Is Nothing Then

            Else
                GrTopSym.MoveRelative xMid, yMid, 0
            End If

            ' ###################################################

        ' Add Second Top Symbol
Dim GrTopSym1 As Graphic
            Set GrTopSym1 = Nothing
            If SymTypeTop1 = "ImBack" Then BackSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImBevel_Groove" Then Bevel_GrooveSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImFillet" Then FilletSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImFlange_Corner" Then Flange_CornerSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImFlange_Edge" Then Flange_EdgeSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImFlare_Bevel" Then Flare_BevelSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImFlare_V" Then Flare_VSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImJ_Groove" Then J_GrooveSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImPlug" Then PlugSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImScarf" Then ScarfSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImSeam" Then SeamSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImSlot" Then SlotSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImSpot" Then Spot_ProjectionSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImSquare" Then SquareSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImSurfacing" Then SurfacingSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImU_Groove" Then U_GrooveSymbol Gr, GrTopSym1, TextHeight
            If SymTypeTop1 = "ImV_Groove" Then V_GrooveSymbol Gr, GrTopSym1, TextHeight
            If GrTopSym1 Is Nothing Then

            Else
                GrTopSym1.MoveRelative xMid, yMid, 0
            End If

            ' ###################################################

            ' Add Text

Dim xSymMax#, ySymMax#, xSymMin#, ySymMin#, xSymMid#
            If GrTopSym Is Nothing Then
                xSymMax = xMid
                xSymMin = xMid
                xSymMid = xMid
                ySymMax = yMid + TextHeight
                ySymMin = yMid
            Else
               With GrTopSym.CalcBoundingBox
                    xSymMax = .Max.x
                    xSymMin = .Min.x
                    ySymMax = .Max.y
                    ySymMin = .Min.y
                    xSymMid = (xSymMax + xSymMin) / 2
               End With
            End If
            yMaxTop = ySymMax
Dim x0Mid#
            x0Mid = xSymMid

            If GrTopSym1 Is Nothing Then
            Else
               With GrTopSym1.CalcBoundingBox
                    xSymMax = .Max.x
                    xSymMin = .Min.x
                    ySymMax = .Max.y
                    ySymMin = .Min.y
                    xSymMid = (xSymMax + xSymMin) / 2
               End With
            End If
Dim hSize_TrTop#
            hSize_TrTop = 0
            ' Add Top Depth-Effective Throat text
            If Size_TrTop <> "" Then
                Set GrChild = Gr.Graphics.Add(imsiGroup)
                GrChild.Cosmetic = True
                Call AddStringWithDiv(Gr, GrChild, Size_TrTop, TextHeight)
                With GrChild.CalcBoundingBox
                    hText = .Max.y - .Min.y
                    hSize_TrTop = hText
                    wText = .Max.x - .Min.x
                    ycText = (.Max.y + .Min.y) / 2
                    xcText = (.Max.x + .Min.x) / 2
                End With
'                If Sign(x3 - x2) > 0 Then
                    dx = xSymMin - wText / 2 - TextHeight / 2 - xcText
'                Else
'                    dx = xSymMax + wText / 2 + TextHeight - xcText
'                End If
                dy = ySymMin + hText / 2 - ycText
                GrChild.MoveRelative dx, dy, 0
            End If
            ' ****************************************************
            ' Move Second Top symbol
Dim ySym1Top#
Dim GrLine As Graphic
            If GrTopSym1 Is Nothing Then
            Else

                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                '  Add Depth of penetration Top Text
Dim dht#
                dht = TextHeight
                If Fill_DepthTop <> "" Then
                    If SymTypeTop = "ImFillet" And SymTypeTop1 <> "ImFillet" And ContourTop <> "None" Then
                        yMaxTop = yMaxTop + 0.7 * TextHeight
                        dht = dht + 0.7 * TextHeight
                    End If
                    Set GrChild = Gr.Graphics.Add(imsiGroup)
                    GrChild.Cosmetic = True
                    Call AddStringWithDiv(Gr, GrChild, Fill_DepthTop, TextHeight)
                    With GrChild.CalcBoundingBox
                        hText = .Max.y - .Min.y
                        wText = .Max.x - .Min.x
                        ycText = (.Max.y + .Min.y) / 2
                        xcText = (.Max.x + .Min.x) / 2
                    End With
                    If wText < 1.3 * TextHeight Then
                        dx = x0Mid - xcText
                    Else
                        dx = xMid + wText / 2 + 0.1 * TextHeight - xcText
                    End If
                    dy = yMaxTop + hText / 2 - ycText
                    GrChild.MoveRelative dx, dy, 0
                    yMaxTop = yMaxTop + hText
                    dht = dht + hText
                End If

                ' Groove Angle text
                If Gr_AngleTop <> "" Then
                    If SymTypeTop = "ImFillet" And SymTypeTop1 <> "ImFillet" And ContourTop <> "None" And Fill_DepthTop = "" Then
'                        If hSize_TrTop < 1.1 * TextHeight Then
                            yMaxTop = yMaxTop + 0.7 * TextHeight
                            dht = dht + 0.7 * TextHeight
'                        End If
                    End If

                    Gr_AngleTop = Gr_AngleTop
                    Set GrChild = Gr.Graphics.AddText(Gr_AngleTop, 0, 0, 0, TextHeight)
                        GrChild.Properties("PenColor") = PenCol
                        GrChild.Cosmetic = True
                    With GrChild.CalcBoundingBox
                        hText = .Max.y - .Min.y
                        wText = .Max.x - .Min.x
                        ycText = (.Max.y + .Min.y) / 2
                        xcText = (.Max.x + .Min.x) / 2
                    End With
                    If wText < 1.3 * TextHeight Then
Dim StrLen%, LastSym$
                        StrLen = VBA.Len(Gr_AngleTop)
                        LastSym = VBA.Right(Gr_AngleTop, 1)
                        If LastSym = VBA.Chr(186) Then
                            dx = x0Mid - xcText + wText / (2 * StrLen)
                        Else
                            dx = x0Mid - xcText
                        End If
                    Else
                        dx = xMid + wText / 2 + 0.1 * TextHeight - xcText
                    End If
                    dy = yMaxTop + TextHeight / 2 - ycText
                    GrChild.MoveRelative dx, dy, 0
                    yMaxTop = yMaxTop + hText
                    dht = dht + hText
                End If
                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

                If hText < dht Then hText = dht

                If Size_TrTop <> "" Or Fill_DepthTop <> "" Or Gr_AngleTop <> "" Then
                    If Abs(hText - TextHeight) > 0.2 * TextHeight Then
                        GrTopSym1.MoveRelative 0, hText, 0
                        Set GrLine = Gr.Graphics.Add(11)
                            GrLine.Properties("PenColor") = PenCol
                            GrLine.Properties("PenWidth") = 0
                            GrLine.Properties("PenStyle") = "CONTINUOUS"
                            On Error Resume Next
                            GrLine.Properties("Thickness") = 0
                            GrLine.Cosmetic = True
                        With GrLine.Vertices
                            .Add xMid, y2 + TextHeight, 0
                            .Add xMid, y2 + hText, 0
                        End With
                        yMaxTop = y2 + hText + TextHeight
                    Else
                        GrTopSym1.MoveRelative 0, 1.2 * hText, 0
                        Set GrLine = Gr.Graphics.Add(11)
                            GrLine.Properties("PenColor") = PenCol
                            GrLine.Properties("PenWidth") = 0
                            GrLine.Properties("PenStyle") = "CONTINUOUS"
                            On Error Resume Next
                            GrLine.Properties("Thickness") = 0
                            GrLine.Cosmetic = True
                        With GrLine.Vertices
                            .Add xMid, y2 + TextHeight, 0
                            .Add xMid, y2 + 1.2 * hText, 0
                        End With
                        yMaxTop = y2 + 1.2 * hText + TextHeight
                    End If
                Else
                    GrTopSym1.MoveRelative 0, 1.2 * TextHeight, 0
                    Set GrLine = Gr.Graphics.Add(11)
                        GrLine.Properties("PenColor") = PenCol
                        GrLine.Properties("PenWidth") = 0
                        GrLine.Properties("PenStyle") = "CONTINUOUS"
                        On Error Resume Next
                        GrLine.Properties("Thickness") = 0
                        GrLine.Cosmetic = True
                    With GrLine.Vertices
                        .Add xMid, y2 + TextHeight, 0
                        .Add xMid, y2 + 1.2 * TextHeight, 0
                    End With
                    yMaxTop = yMaxTop + 1.2 * TextHeight
                End If
                ySym1Top = yMaxTop
            End If

            If SymTypeTop = "ImFillet" And SymTypeTop1 = "ImNone" And ContourTop <> "None" Then
                yMaxTop = yMaxTop + 0.7 * TextHeight
            End If
            If SymTypeTop1 = "ImFillet" And ContourTop <> "None" Then
                yMaxTop = yMaxTop + 0.3 * TextHeight
            End If

            ' ****************************************************
            ' Add Second Top Depth-Effective Throat text
            If Size_TrTop1 <> "" Then
                Set GrChild = Gr.Graphics.Add(imsiGroup)
                GrChild.Cosmetic = True
                Call AddStringWithDiv(Gr, GrChild, Size_TrTop1, TextHeight)
                With GrChild.CalcBoundingBox
                    hText = .Max.y - .Min.y
                    wText = .Max.x - .Min.x
                    ycText = (.Max.y + .Min.y) / 2
                    xcText = (.Max.x + .Min.x) / 2
                End With
                dx = xSymMin - wText / 2 - TextHeight / 2 - xcText
                If SymTypeTop1 = "ImFillet" And ContourTop <> "None" Then
                    dy = yMaxTop - TextHeight - 0.3 * TextHeight + hText / 2 - ycText
                Else
                    dy = yMaxTop - TextHeight + hText / 2 - ycText
                End If
                GrChild.MoveRelative dx, dy, 0
            End If

            ' Add Length-Pitch text
            If Len_PitTop <> "" Then
                Set GrChild = Gr.Graphics.AddText(Len_PitTop, 0, 0, 0, TextHeight)
                    GrChild.Properties("PenColor") = PenCol
                    GrChild.Cosmetic = True
                With GrChild.CalcBoundingBox
                    hText = .Max.y - .Min.y
                    wText = .Max.x - .Min.x
                    ycText = (.Max.y + .Min.y) / 2
                    xcText = (.Max.x + .Min.x) / 2
                End With
                dx = xSymMax + wText / 2 + TextHeight / 2 - xcText
                dy = ySymMin + hText / 2 - ycText
                GrChild.MoveRelative dx, dy, 0
            End If

            If SymTypeTop1 = "ImNone" Then
                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                '  Add Depth of penetration Top Text
                If Fill_DepthTop <> "" Then

                    Set GrChild = Gr.Graphics.Add(imsiGroup)
                    GrChild.Cosmetic = True
                    Call AddStringWithDiv(Gr, GrChild, Fill_DepthTop, TextHeight)
                    With GrChild.CalcBoundingBox
                        hText = .Max.y - .Min.y
                        wText = .Max.x - .Min.x
                        ycText = (.Max.y + .Min.y) / 2
                        xcText = (.Max.x + .Min.x) / 2
                    End With
                    dx = xSymMid - xcText
                    dy = yMaxTop + hText / 2 - ycText
                    GrChild.MoveRelative dx, dy, 0
                    yMaxTop = yMaxTop + hText
                End If

                ' Groove Angle text
                If Gr_AngleTop <> "" Then

                    Gr_AngleTop = Gr_AngleTop
                    Set GrChild = Gr.Graphics.AddText(Gr_AngleTop, 0, 0, 0, TextHeight)
                        GrChild.Properties("PenColor") = PenCol
                        GrChild.Cosmetic = True
                    With GrChild.CalcBoundingBox
                        hText = .Max.y - .Min.y
                        wText = .Max.x - .Min.x
                        ycText = (.Max.y + .Min.y) / 2
                        xcText = (.Max.x + .Min.x) / 2
                    End With
                    StrLen = VBA.Len(Gr_AngleTop)
                    LastSym = VBA.Right(Gr_AngleTop, 1)
                    If LastSym = VBA.Chr(186) Then
                        dx = xSymMid - xcText + wText / (2 * StrLen)
                    Else
                        dx = xSymMid - xcText
                    End If
                    dy = yMaxTop + TextHeight / 2 - ycText
                    GrChild.MoveRelative dx, dy, 0
                    yMaxTop = yMaxTop + hText
                End If
                '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
            End If

            ' Draw Contour Top Symbol
Dim StrCont$
            If ContourTop <> "None" Then
                If ContourTop = "Flush" Then
                    StrCont = VBA.Chr(117)
                    Set GrChild = Gr.Graphics.AddText(StrCont, 0, 0, 0, TextHeight)
                        GrChild.Properties("PenColor") = PenCol
                        GrChild.Cosmetic = True
                    GrChild.Properties("TextFont") = "gdt.shx"
                End If
                If ContourTop = "Convex" Then
                    StrCont = VBA.Chr(94)
                    Set GrChild = Gr.Graphics.AddText(StrCont, 0, 0, 0, TextHeight)
                        GrChild.Properties("PenColor") = PenCol
                        GrChild.Cosmetic = True
                    GrChild.Properties("TextFont") = "gdt.shx"
                End If
                If ContourTop = "Concave" Then
                    StrCont = VBA.Chr(94)
                    Set GrChild = Gr.Graphics.AddText(StrCont, 0, 0, 0, TextHeight, Pi)
                        GrChild.Properties("PenColor") = PenCol
                        GrChild.Cosmetic = True
                    GrChild.Properties("TextFont") = "gdt.shx"
                End If
                With GrChild.CalcBoundingBox
                    hText = .Max.y - .Min.y
                    wText = .Max.x - .Min.x
                    ycText = (.Max.y + .Min.y) / 2
                    xcText = (.Max.x + .Min.x) / 2
                End With
                If SymTypeTop <> "ImFillet" And SymTypeTop1 <> "ImFillet" Then
                    dx = xSymMid - xcText
                    dy = yMaxTop + hText / 4 - ycText
                    GrChild.MoveRelative dx, dy, 0
                    yMaxTop = yMaxTop + hText / 2
                Else
Dim xcc#, ycc#
Dim k#
                    If ContourTop = "Flush" Then
                        k = 0.7
                    Else
                        k = 1
                    End If
                    If SymTypeTop = "ImFillet" And SymTypeTop1 <> "ImFillet" Then
                        xcc = xSymMid
                        ycc = (ySymMax + ySymMin) / 2
                        dx = xcc + k * hText / 2 * Cos(Pi / 4) - xcText
                        dy = ycc + k * hText / 2 * Sin(Pi / 4) - ycText
                        GrChild.RotateAxis -Pi / 4, 0, 0, 1, xcText, ycText, 0
                        GrChild.MoveRelative dx, dy, 0
                    End If
                    If SymTypeTop1 = "ImFillet" Then
                        xcc = xMid + TextHeight / 2
                        ycc = ySym1Top - TextHeight / 2
                        dx = xcc + k * hText / 2 * Cos(Pi / 4) - xcText
                        dy = ycc + k * hText / 2 * Sin(Pi / 4) - ycText
                        GrChild.RotateAxis -Pi / 4, 0, 0, 1, xcText, ycText, 0
                        GrChild.MoveRelative dx, dy, 0
                    End If
                End If
            End If

            ' Draw Finish Top Symbol
Dim StrFinish$
            If FinishTop <> "None" Then
                StrFinish = VBA.Left(FinishTop, 1)
                Set GrChild = Gr.Graphics.AddText(StrFinish, 0, 0, 0, TextHeight)
                    GrChild.Properties("PenColor") = PenCol
                    GrChild.Cosmetic = True
                With GrChild.CalcBoundingBox
                    hText = .Max.y - .Min.y
                    wText = .Max.x - .Min.x
                    ycText = (.Max.y + .Min.y) / 2
                    xcText = (.Max.x + .Min.x) / 2
                End With
                If SymTypeTop <> "ImFillet" And SymTypeTop1 <> "ImFillet" Then
                    dx = xSymMid - xcText
                    dy = yMaxTop + hText / 2 - ycText
                    GrChild.MoveRelative dx, dy, 0
                    yMaxTop = yMaxTop + hText
                Else
                    If SymTypeTop = "ImFillet" And SymTypeTop1 <> "ImFillet" Then
                        xcc = xSymMid
                        ycc = (ySymMax + ySymMin) / 2
                        If ContourTop = "None" Then
                            dx = xcc + hText / 2 * Cos(Pi / 4) - xcText
                            dy = ycc + hText / 2 * Sin(Pi / 4) - ycText
                        Else
                            dx = xcc + 2.5 * hText / 2 * Cos(Pi / 4) - xcText
                            dy = ycc + 2.5 * hText / 2 * Sin(Pi / 4) - ycText
                        End If
                    End If
                    If SymTypeTop1 = "ImFillet" Then
                        xcc = xMid + TextHeight / 2
                        ycc = ySym1Top - TextHeight / 2
                        If ContourTop = "None" Then
                            dx = xcc + hText / 2 * Cos(Pi / 4) - xcText
                            dy = ycc + hText / 2 * Sin(Pi / 4) - ycText
                        Else
                            dx = xcc + 2.5 * hText / 2 * Cos(Pi / 4) - xcText
                            dy = ycc + 2.5 * hText / 2 * Sin(Pi / 4) - ycText
                        End If

                    End If
'                    GrChild.RotateAxis -Pi / 4, 0, 0, 1, xcText, ycText, 0
                    GrChild.MoveRelative dx, dy, 0
                End If
            End If

            ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
            ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
            ' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Dim GrSets As GraphicSets
Dim GrSet As GraphicSet
            Set GrSets = Gr.Drawing.GraphicSets
            Set GrSet = GrSets.Add
            ' Bottom Side
Dim GrBotSym As Graphic
            Set GrBotSym = Nothing
            If SymTypeBot = "ImBack" Then BackSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImBevel_Groove" Then Bevel_GrooveSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImFillet" Then FilletSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImFlange_Corner" Then Flange_CornerSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImFlange_Edge" Then Flange_EdgeSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImFlare_Bevel" Then Flare_BevelSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImFlare_V" Then Flare_VSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImJ_Groove" Then J_GrooveSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImPlug" Then PlugSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImScarf" Then ScarfSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImSeam" Then SeamSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImSlot" Then SlotSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImSpot" Then Spot_ProjectionSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImSquare" Then SquareSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImSurfacing" Then SurfacingSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImU_Groove" Then U_GrooveSymbol Gr, GrBotSym, TextHeight
            If SymTypeBot = "ImV_Groove" Then V_GrooveSymbol Gr, GrBotSym, TextHeight
            If GrBotSym Is Nothing Then

            Else
                GrBotSym.MoveRelative xMid, yMid, 0
                GrBotSym.RotateAxis Pi, 1, 0, 0, xMid, yMid, 0
                GrSet.AddGraphic GrBotSym
            End If
            ' ###################################################

        ' Add Second Bottom Symbol
Dim GrBotSym1 As Graphic
            Set GrBotSym1 = Nothing
            If SymTypeBot1 = "ImBack" Then BackSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImBevel_Groove" Then Bevel_GrooveSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImFillet" Then FilletSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImFlange_Corner" Then Flange_CornerSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImFlange_Edge" Then Flange_EdgeSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImFlare_Bevel" Then Flare_BevelSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImFlare_V" Then Flare_VSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImJ_Groove" Then J_GrooveSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImPlug" Then PlugSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImScarf" Then ScarfSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImSeam" Then SeamSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImSlot" Then SlotSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImSpot" Then Spot_ProjectionSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImSquare" Then SquareSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImSurfacing" Then SurfacingSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImU_Groove" Then U_GrooveSymbol Gr, GrBotSym1, TextHeight
            If SymTypeBot1 = "ImV_Groove" Then V_GrooveSymbol Gr, GrBotSym1, TextHeight
            If GrBotSym1 Is Nothing Then

            Else
                GrBotSym1.MoveRelative xMid, yMid, 0
                GrBotSym1.RotateAxis Pi, 1, 0, 0, xMid, yMid, 0
            End If

            ' ###################################################

            ' Add Bottom Text

            If GrBotSym Is Nothing Then
                xSymMax = xMid
                xSymMin = xMid
                xSymMid = xMid
                ySymMax = yMid
                ySymMin = yMid - TextHeight
            Else
               With GrBotSym.CalcBoundingBox
                    xSymMax = .Max.x
                    xSymMin = .Min.x
                    ySymMax = .Max.y
                    ySymMin = .Min.y
                    xSymMid = (xSymMax + xSymMin) / 2
               End With
            End If
            yMinBot = ySymMin
            x0Mid = xSymMid
            If GrBotSym1 Is Nothing Then
            Else
               With GrBotSym1.CalcBoundingBox
                    xSymMax = .Max.x
                    xSymMin = .Min.x
                    ySymMax = .Max.y
                    ySymMin = .Min.y
                    xSymMid = (xSymMax + xSymMin) / 2
               End With
            End If

            ' Add Bot Depth-Effective Throat text
Dim hSize_TrBot#
            hSize_TrBot = 0
            If Size_TrBot <> "" Then

                Set GrChild = Gr.Graphics.Add(imsiGroup)
                GrChild.Cosmetic = True
                Call AddStringWithDiv(Gr, GrChild, Size_TrBot, TextHeight)
                With GrChild.CalcBoundingBox
                    hText = .Max.y - .Min.y
                    hSize_TrBot = hText
                    wText = .Max.x - .Min.x
                    ycText = (.Max.y + .Min.y) / 2
                    xcText = (.Max.x + .Min.x) / 2
                End With
                dx = xSymMin - wText / 2 - TextHeight / 2 - xcText
                dy = ySymMax - hText / 2 - ycText
                GrChild.MoveRelative dx, dy, 0
                GrSet.AddGraphic GrChild
            End If

            ' ****************************************************
            ' Move Second Top symbol
Dim ySym1Bot#
            If GrBotSym1 Is Nothing Then

            Else
                ' ######################################
                dht = TextHeight
                 '  Add Depth of Penetration Bot Text
                If Fill_DepthBot <> "" Then
                    If SymTypeBot = "ImFillet" And SymTypeBot1 <> "ImFillet" And ContourBot <> "None" Then
                        yMinBot = yMinBot - 0.7 * TextHeight
                        dht = dht + 0.7 * TextHeight
                    End If
                    Set GrChild = Gr.Graphics.Add(imsiGroup)
                    GrChild.Cosmetic = True
                    Call AddStringWithDiv(Gr, GrChild, Fill_DepthBot, TextHeight)
                    With GrChild.CalcBoundingBox
                        hText = .Max.y - .Min.y
                        wText = .Max.x - .Min.x
                        ycText = (.Max.y + .Min.y) / 2
                        xcText = (.Max.x + .Min.x) / 2
                    End With
                    If wText < 1.3 * TextHeight Then
                        dx = x0Mid - xcText
                    Else
                        dx = xMid + wText / 2 + 0.1 * TextHeight - xcText
                    End If
 '                   dx = x0Mid - xcText
                    dy = yMinBot - hText / 2 - ycText
                    GrChild.MoveRelative dx, dy, 0
                    yMinBot = yMinBot - hText
                    GrSet.AddGraphic GrChild
                    dht = dht + hText
                End If

                If Gr_AngleBot <> "" Then
                    If SymTypeBot = "ImFillet" And SymTypeBot1 <> "ImFillet" And ContourBot <> "None" And Fill_DepthBot = "" Then
                        yMinBot = yMinBot - 0.7 * TextHeight
                        dht = dht + 0.7 * TextHeight
                    End If

                    Gr_AngleBot = Gr_AngleBot
                    Set GrChild = Gr.Graphics.AddText(Gr_AngleBot, 0, 0, 0, TextHeight)
                        GrChild.Properties("PenColor") = PenCol
                        GrChild.Cosmetic = True
                    With GrChild.CalcBoundingBox
                        hText = .Max.y - .Min.y
                        wText = .Max.x - .Min.x
                        ycText = (.Max.y + .Min.y) / 2
                        xcText = (.Max.x + .Min.x) / 2
                    End With

                    If wText < 1.3 * TextHeight Then
                        StrLen = VBA.Len(Gr_AngleBot)
                        LastSym = VBA.Right(Gr_AngleBot, 1)
                        If LastSym = VBA.Chr(186) Then
                            dx = x0Mid - xcText + wText / (2 * StrLen)
                        Else
                            dx = x0Mid - xcText
                        End If
                    Else
                        dx = xMid + wText / 2 + 0.1 * TextHeight - xcText
                    End If
                    dy = yMinBot - TextHeight / 2 - ycText
                    GrChild.MoveRelative dx, dy, 0
                    yMinBot = yMinBot - hText
                    GrSet.AddGraphic GrChild
                    dht = dht + hText
                End If
                ' ######################################
                If dht > hText Then hText = dht

                If Size_TrBot <> "" Or Fill_DepthBot <> "" Or Gr_AngleBot <> "" Then
                    If Abs(hText - TextHeight) > 0.2 * TextHeight Then
                        GrBotSym1.MoveRelative 0, -hText, 0
                        Set GrLine = Gr.Graphics.Add(11)
                            GrLine.Properties("PenColor") = PenCol
                            GrLine.Properties("PenWidth") = 0
                            GrLine.Properties("PenStyle") = "CONTINUOUS"
                            On Error Resume Next
                            GrLine.Properties("Thickness") = 0
                            GrLine.Cosmetic = True
                        With GrLine.Vertices
                            .Add xMid, y2 - TextHeight, 0
                            .Add xMid, y2 - hText, 0
                        End With
                        yMinBot = y2 - hText - TextHeight
                    Else
                        GrBotSym1.MoveRelative 0, -1.2 * hText, 0
                        Set GrLine = Gr.Graphics.Add(11)
                            GrLine.Properties("PenColor") = PenCol
                            GrLine.Properties("PenWidth") = 0
                            GrLine.Properties("PenStyle") = "CONTINUOUS"
                            On Error Resume Next
                            GrLine.Properties("Thickness") = 0
                            GrLine.Cosmetic = True
                        With GrLine.Vertices
                            .Add xMid, y2 - TextHeight, 0
                            .Add xMid, y2 - 1.2 * hText, 0
                        End With
                        yMinBot = y2 - 1.2 * hText - TextHeight
                    End If
                Else
                    GrBotSym1.MoveRelative 0, -1.2 * TextHeight, 0
                    Set GrLine = Gr.Graphics.Add(11)
                        GrLine.Properties("PenColor") = PenCol
                        GrLine.Properties("PenWidth") = 0
                        GrLine.Properties("PenStyle") = "CONTINUOUS"
                        On Error Resume Next
                        GrLine.Properties("Thickness") = 0
                        GrLine.Cosmetic = True
                    With GrLine.Vertices
                        .Add xMid, y2 - TextHeight, 0
                        .Add xMid, y2 - 1.2 * TextHeight, 0
                    End With
                    yMinBot = yMinBot - TextHeight
                End If
                ySym1Bot = yMinBot
                GrSet.AddGraphic GrBotSym1
                GrSet.AddGraphic GrLine
            End If
            ' ****************************************************
            If SymTypeBot = "ImFillet" And SymTypeBot1 = "ImNone" And ContourBot <> "None" Then
                yMinBot = yMinBot - 0.3 * TextHeight
            End If
            If SymTypeBot1 = "ImFillet" And ContourBot <> "None" Then
                yMinBot = yMinBot - 0.3 * TextHeight
            End If

            ' Add Length-Pitch text
            If Len_PitBot <> "" Then
                Set GrChild = Gr.Graphics.AddText(Len_PitBot, 0, 0, 0, TextHeight)
                    GrChild.Properties("PenColor") = PenCol
                    GrChild.Cosmetic = True
                With GrChild.CalcBoundingBox
                    hText = .Max.y - .Min.y
                    wText = .Max.x - .Min.x
                    ycText = (.Max.y + .Min.y) / 2
                    xcText = (.Max.x + .Min.x) / 2
                End With
                dx = xSymMax + wText / 2 + TextHeight / 2 - xcText
                dy = ySymMax - hText / 2 - ycText
                GrChild.MoveRelative dx, dy, 0
                GrSet.AddGraphic GrChild
            End If

            ' Add Second Bot Depth-Effective Throat text
            If Size_TrBot1 <> "" Then
                Set GrChild = Gr.Graphics.Add(imsiGroup)
                GrChild.Cosmetic = True
                Call AddStringWithDiv(Gr, GrChild, Size_TrBot1, TextHeight)
                With GrChild.CalcBoundingBox
                    hText = .Max.y - .Min.y
                    wText = .Max.x - .Min.x
                    ycText = (.Max.y + .Min.y) / 2
                    xcText = (.Max.x + .Min.x) / 2
                End With
                dx = xSymMin - wText / 2 - TextHeight / 2 - xcText
                If SymTypeBot1 = "ImFillet" And ContourBot <> "None" Then
                    dy = yMinBot + TextHeight + 0.3 * TextHeight - hText / 2 - ycText
                Else
                    dy = yMinBot + TextHeight - hText / 2 - ycText
                End If
                GrChild.MoveRelative dx, dy, 0
                GrSet.AddGraphic GrChild
            End If
            ' ##################################################
            If GrBotSym1 = "ImNone" Then
                 '  Add Depth of Penetration Bot Text
                If Fill_DepthBot <> "" Then
                    Set GrChild = Gr.Graphics.Add(imsiGroup)
                    GrChild.Cosmetic = True
                    Call AddStringWithDiv(Gr, GrChild, Fill_DepthBot, TextHeight)
                    With GrChild.CalcBoundingBox
                        hText = .Max.y - .Min.y
                        wText = .Max.x - .Min.x
                        ycText = (.Max.y + .Min.y) / 2
                        xcText = (.Max.x + .Min.x) / 2
                    End With
                    dx = xSymMid - xcText
                    dy = yMinBot - hText / 2 - ycText
                    GrChild.MoveRelative dx, dy, 0
                    yMinBot = yMinBot - hText
                    GrSet.AddGraphic GrChild
                End If

                If Gr_AngleBot <> "" Then
                    Gr_AngleBot = Gr_AngleBot
                    Set GrChild = Gr.Graphics.AddText(Gr_AngleBot, 0, 0, 0, TextHeight)
                        GrChild.Properties("PenColor") = PenCol
                        GrChild.Cosmetic = True
                    With GrChild.CalcBoundingBox
                        hText = .Max.y - .Min.y
                        wText = .Max.x - .Min.x
                        ycText = (.Max.y + .Min.y) / 2
                        xcText = (.Max.x + .Min.x) / 2
                    End With

                    StrLen = VBA.Len(Gr_AngleBot)
                    LastSym = VBA.Right(Gr_AngleBot, 1)
                    If LastSym = VBA.Chr(186) Then
                        dx = xSymMid - xcText + wText / (2 * StrLen)
                    Else
                        dx = xSymMid - xcText
                    End If
                    dy = yMinBot - TextHeight / 2 - ycText
                    GrChild.MoveRelative dx, dy, 0
                    yMinBot = yMinBot - hText
                    GrSet.AddGraphic GrChild
                End If
            End If
            '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

            ' Draw Contour Bot Symbol
            If ContourBot <> "None" Then
                If ContourBot = "Flush" Then
                    StrCont = VBA.Chr(117)
                    Set GrChild = Gr.Graphics.AddText(StrCont, 0, 0, 0, TextHeight)
                        GrChild.Properties("PenColor") = PenCol
                        GrChild.Cosmetic = True
                    GrChild.Properties("TextFont") = "gdt.shx"
                End If
                If ContourBot = "Convex" Then
                    StrCont = VBA.Chr(94)
                    Set GrChild = Gr.Graphics.AddText(StrCont, 0, 0, 0, TextHeight, Pi)
                        GrChild.Properties("PenColor") = PenCol
                        GrChild.Cosmetic = True
                    GrChild.Properties("TextFont") = "gdt.shx"
                End If
                If ContourBot = "Concave" Then
                    StrCont = VBA.Chr(94)
                    Set GrChild = Gr.Graphics.AddText(StrCont, 0, 0, 0, TextHeight)
                        GrChild.Properties("PenColor") = PenCol
                        GrChild.Cosmetic = True
                    GrChild.Properties("TextFont") = "gdt.shx"
                End If
                With GrChild.CalcBoundingBox
                    hText = .Max.y - .Min.y
                    wText = .Max.x - .Min.x
                    ycText = (.Max.y + .Min.y) / 2
                    xcText = (.Max.x + .Min.x) / 2
                End With
                If SymTypeBot <> "ImFillet" And SymTypeBot1 <> "ImFillet" Then
                    dx = xSymMid - xcText
                    dy = yMinBot - hText / 4 - ycText
                    GrChild.MoveRelative dx, dy, 0
                    yMinBot = yMinBot - hText / 2
                Else
                    If ContourTop = "Flush" Then
                        k = 1.2
                    Else
                        k = 1
                    End If
                    If SymTypeBot = "ImFillet" And SymTypeBot1 <> "ImFillet" Then
                        xcc = xSymMid
                        ycc = (ySymMax + ySymMin) / 2
                        dx = xcc + k * hText / 2 * Cos(Pi / 4) - xcText
                        dy = ycc - k * hText / 2 * Sin(Pi / 4) - ycText
                        GrChild.RotateAxis Pi / 4, 0, 0, 1, xcText, ycText, 0
                        GrChild.MoveRelative dx, dy, 0
                    End If
                    If SymTypeBot1 = "ImFillet" Then
                        xcc = xMid + TextHeight / 2
                        ycc = ySym1Bot + TextHeight / 2
                        dx = xcc + k * hText / 2 * Cos(Pi / 4) - xcText
                        dy = ycc - k * hText / 2 * Sin(Pi / 4) - ycText
                        GrChild.RotateAxis Pi / 4, 0, 0, 1, xcText, ycText, 0
                        GrChild.MoveRelative dx, dy, 0
                    End If
                End If
                GrSet.AddGraphic GrChild
            End If

            ' Draw Finish Bot Symbol
            If FinishBot <> "None" Then
                StrFinish = VBA.Left(FinishBot, 1)
                Set GrChild = Gr.Graphics.AddText(StrFinish, 0, 0, 0, TextHeight)
                    GrChild.Properties("PenColor") = PenCol
                    GrChild.Cosmetic = True
                With GrChild.CalcBoundingBox
                    hText = .Max.y - .Min.y
                    wText = .Max.x - .Min.x
                    ycText = (.Max.y + .Min.y) / 2
                    xcText = (.Max.x + .Min.x) / 2
                End With
                If SymTypeBot <> "ImFillet" And SymTypeBot1 <> "ImFillet" Then
                    dx = xSymMid - xcText
                    dy = yMinBot - hText / 2 - ycText
                    GrChild.MoveRelative dx, dy, 0
                    yMaxTop = yMinBot + hText
                Else
                    If SymTypeBot = "ImFillet" And SymTypeBot1 <> "ImFillet" Then
                        xcc = xSymMid
                        ycc = (ySymMax + ySymMin) / 2
                        If ContourBot = "None" Then
                            dx = xcc + hText / 2 * Cos(Pi / 4) - xcText
                            dy = ycc - hText / 2 * Sin(Pi / 4) - ycText
                        Else
                            dx = xcc + 2.5 * hText / 2 * Cos(Pi / 4) - xcText
                            dy = ycc - 2.5 * hText / 2 * Sin(Pi / 4) - ycText
                        End If
    '                    GrChild.RotateAxis Pi / 4, 0, 0, 1, xcText, ycText, 0
                        GrChild.MoveRelative dx, dy, 0
                    End If
                    If SymTypeBot1 = "ImFillet" Then
                        xcc = xMid + TextHeight / 2
                        ycc = ySym1Bot + TextHeight / 2
                        If ContourBot = "None" Then
                            dx = xcc + hText / 2 * Cos(Pi / 4) - xcText
                            dy = ycc - hText / 2 * Sin(Pi / 4) - ycText
                        Else
                            dx = xcc + 2.5 * hText / 2 * Cos(Pi / 4) - xcText
                            dy = ycc - 2.5 * hText / 2 * Sin(Pi / 4) - ycText
                        End If
    '                    GrChild.RotateAxis Pi / 4, 0, 0, 1, xcText, ycText, 0
                        GrChild.MoveRelative dx, dy, 0
                    End If
                End If
                GrSet.AddGraphic GrChild
            End If
Dim i As Long, GrSetCount As Long
            GrSetCount = GrSet.Count

            If Intermittent = 1 Then
                For i = 0 To GrSetCount - 1
                    Set GrChild = GrSet(i)
                    GrChild.MoveRelative TextHeight / 2 * Sign(x3 - x2), 0, 0
                Next i
            End If
            GrSet.Clear
            Set GrSet = Nothing
            Set GrSets = Nothing

Dim xMax#, xMin#, xMa#, xMi#, xc#
            xMax = -10000000
            xMin = 10000000
            GrCount = Gr.Graphics.Count

            For i = 1 To GrCount - 1
                Set GrChild = Gr.Graphics(i)
                With GrChild.CalcBoundingBox
                    xMa = .Max.x
                    xMi = .Min.x
                End With
                If xMa > xMax Then xMax = xMa
                If xMi < xMin Then xMin = xMi
            Next i
Dim L#
            xc = (xMax + xMin) / 2
            L = xMax - xMin + TextHeight
Dim L32#, xc32#
            If Abs(L) < 10000000 - 1 Then
                If WeldAround = 0 And WeldField = 0 Then
                    x3 = x2 + L * Sign(x3 - x2)
                    xc32 = (x3 + x2) / 2
                Else
                    x3 = x2 + (L + LeaderSize) * Sign(x3 - x2)
                    xc32 = (x3 + x2) / 2 + LeaderSize / 2 * Sign(x3 - x2)
                End If

                For i = 1 To GrCount - 1
                    Set GrChild = Gr.Graphics(i)
                    GrChild.MoveRelative xc32 - xc, 0, 0
                Next i

'                Gr.Vertices(iLast).Editable = False
                Gr.Vertices(iLast).x = x3
            Else
'                Gr.Vertices(iLast).Editable = False
                x3 = x2 + 5 * TextHeight * Sign(x3 - x2)
                Gr.Vertices(iLast).x = x3
            End If
'###################################################################
'###################################################################
'###################################################################
'###################################################################

            ' Add Line to define if ConvertUnits is active
            Set GrChild = Gr.Graphics.Add(11)
                GrChild.Properties("PenStyle") = "CONTINUOUS"
                On Error Resume Next
                GrChild.Properties("Thickness") = 0
                GrChild.Visible = False
                GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add x2, y2, 0, False, False, False, False, False, False
                .Add x2 + 0.01, y2, 0, False, False, False, False, False, False
            End With

            ' Add Base Line
            Set GrChild = Gr.Graphics.Add(11)
                GrChild.Properties("PenColor") = PenCol
                GrChild.Properties("PenWidth") = PenWid
                GrChild.Properties("PenStyle") = "CONTINUOUS"
                On Error Resume Next
                GrChild.Properties("Thickness") = 0
                GrChild.Cosmetic = True
                GrChild.Properties("Info") = "CosmPoly"
Dim xi#, yi#
                With GrChild.Vertices
                    For i = 0 To VersCount - 1
                        xi = Gr.Vertices(i).x
                        yi = Gr.Vertices(i).y
                        If i = VersCount - 1 Then
                            .Add xi, yi, 0, True
                        Else
                            .Add xi, yi, 0, True
                        End If
                    Next i
                End With
                GrChild.Properties("LimitVertices") = True

            ' Add Pointer
            With Gr.Vertices
                x0 = .Item(0).x
                y0 = .Item(0).y
                x1 = .Item(1).x
                y1 = .Item(1).y
            End With
            L01 = Sqr((x1 - x0) * (x1 - x0) + (y1 - y0) * (y1 - y0))
            sina = (y1 - y0) / L01
            cosa = (x1 - x0) / L01
            Bet = Angle(sina, cosa)
            lPoint = LeaderSize
            wPoint = lPoint / 4
            Set GrChild = Gr.Graphics.Add(11)
                GrChild.Properties("PenColor") = PenCol
                GrChild.Properties("PenWidth") = PenWid
                GrChild.Properties("PenStyle") = "CONTINUOUS"
                On Error Resume Next
                GrChild.Properties("Thickness") = 0
                GrChild.Cosmetic = True
            With GrChild.Vertices
                .Add 0, 0, 0
                .Add lPoint, wPoint, 0
                .Add lPoint, -wPoint, 0
                .AddClose
            End With
            GrChild.Properties("BrushStyle") = "Solid"

            GrChild.MoveRelative x0, y0, 0
            GrChild.RotateAxis Bet, 0, 0, 1, x0, y0, 0

            ' Add Weld-around symbol
            RAround = LeaderSize / 2
            If WeldAround = 1 Then
                Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(x2, y2, 0, x2 + RAround, y2, 0)
                GrChild.Properties("PenColor") = PenCol
                GrChild.Properties("PenWidth") = PenWid
                GrChild.Properties("PenStyle") = "CONTINUOUS"
                On Error Resume Next
                GrChild.Properties("Thickness") = 0
                    GrChild.Cosmetic = True
                GrChild.Properties("BrushStyle") = ""
            End If

            ' Add Field-Weld symbol
            If WeldField = 1 Then
                Set GrChild = Gr.Graphics.Add(11)
                    GrChild.Properties("PenColor") = PenCol
                    GrChild.Properties("PenWidth") = PenWid
                    GrChild.Properties("PenStyle") = "CONTINUOUS"
                    On Error Resume Next
                    GrChild.Properties("Thickness") = 0
                    GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add x2, y2, 0
                    .Add x2, y2 + 3 * LeaderSize, 0
                End With

                Set GrChild = Gr.Graphics.Add(11)
                    GrChild.Properties("PenColor") = PenCol
                    GrChild.Properties("PenWidth") = PenWid
                    GrChild.Properties("PenStyle") = "CONTINUOUS"
                    On Error Resume Next
                    GrChild.Properties("Thickness") = 0
                    GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add x2, y2 + 3 * LeaderSize, 0
'                    .Add x2 + Sign(x3 - x2) * LeaderSize, y2 + 3 * LeaderSize - 0.5 * LeaderSize, 0
                    .Add x2 + LeaderSize, y2 + 3 * LeaderSize - 0.5 * LeaderSize, 0
                    .Add x2, y2 + 3 * LeaderSize - 1 * LeaderSize, 0
                    .AddClose
                End With
                GrChild.Properties("BrushStyle") = "Solid"
            End If

            ' Add Tail symbol
            wTail = TextHeight
            If WeldTail = 1 Then
                Set GrChild = Gr.Graphics.Add(11)
                    GrChild.Properties("PenColor") = PenCol
                    GrChild.Properties("PenWidth") = PenWid
                    GrChild.Properties("PenStyle") = "CONTINUOUS"
                    On Error Resume Next
                    GrChild.Properties("Thickness") = 0
                    GrChild.Cosmetic = True
                With GrChild.Vertices
                    .Add x3 + Sign(x3 - x2) * wTail, y3 + wTail, 0
                    .Add x3, y3, 0
                    .Add x3 + Sign(x3 - x2) * wTail, y3 - wTail, 0
                End With
            End If

            ' Add Tail text
            hTailText = TextHeight
            If TailText <> "" Then
Dim jj%, Char$
                StrLen = VBA.Len(TailText)
                jj = 1
                For i = StrLen To 1 Step -1
                    If VBA.Asc(Mid(TailText, i, 1)) = 10 Or VBA.Asc(Mid(TailText, i, 1)) = 13 Then
                    Else
                       Char = VBA.Left(TailText, i)
                        TailText = ""
                        TailText = Char
                        Exit For
                    End If
                Next i
                StrLen = VBA.Len(TailText)
                For i = 1 To StrLen
                    Char = VBA.Mid(TailText, i, 1)
                    If VBA.Asc(Char) = 10 Then
                        jj = jj + 1
                    End If
                Next i
Dim TailTextOffset#
                TailTextOffset = 1
                If jj > 1 Then
                    hTailText = TextHeight * jj
                    If jj = 2 Then TailTextOffset = 1.8
                    If jj > 2 Then TailTextOffset = 2.3
                End If
                Set GrChild = Gr.Graphics.AddText(TailText, 0, 0, 0, hTailText)
                    GrChild.Properties("PenColor") = PenCol
                    GrChild.Cosmetic = True
                With GrChild.CalcBoundingBox
                    hText = .Max.y - .Min.y
                    wText = .Max.x - .Min.x
                    ycText = (.Max.y + .Min.y) / 2
                    xcText = (.Max.x + .Min.x) / 2
                End With
                If Sign(x3 - x2) > 0 Then
                    dx = x3 + TailTextOffset * wTail / 2 + wText / 2 - xcText
                Else
                    dx = x3 - TailTextOffset * wTail / 2 - wText / 2 - xcText
                End If
                dy = y3 - ycText
                GrChild.MoveRelative dx, dy, 0
            End If
'###################################################################
'###################################################################
'###################################################################
'###################################################################

        End If  ' End If LockCount& = 0

        Gr.RegenUnlock

        Set GrTopSym = Nothing
        Set GrTopSym1 = Nothing
        Set GrBotSym = Nothing
        Set GrBotSym1 = Nothing
        Set GrChild = Nothing
        Set GrLine = Nothing
        Set Gr = Nothing
        Exit Function

FailedLock:
        'Remove lock
        Gr.RegenUnlock

Failed:
        'grfThis.Application.PopVertexDefaults

        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function

Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function

Private Function Sign(y As Double) As Double
    If Abs(y) < 0.001 Then
        Sign = 0
        Exit Function
    End If
    If y < 0 Then
        Sign = -1#
        Exit Function
    End If
    If y > 0 Then
        Sign = 1#
        Exit Function
    End If
End Function

'###########################################################
'###########################################################
'###########################################################
'###########################################################

' Back Symbol
Private Sub BackSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)

    Set GrSym = Gr.Graphics.AddArcTriplePoint(-SizeSym / 2, 0, 0, 0, SizeSym / 3, 0, SizeSym / 2, 0, 0)
        GrSym.Cosmetic = True

End Sub

'Bevel-Groove Symbol
Private Sub Bevel_GrooveSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)

    Set GrSym = Gr.Graphics.Add(11)
        GrSym.Properties("PenColor") = PenCol
        GrSym.Properties("PenWidth") = PenWid
        GrSym.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrSym.Properties("Thickness") = 0
        GrSym.Cosmetic = True
    With GrSym.Vertices
        .Add 0, SizeSym, 0
        .Add 0, 0, 0
        .Add SizeSym, SizeSym, 0
    End With

End Sub

'Fillet Symbol
Private Sub FilletSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)

    Set GrSym = Gr.Graphics.Add(11)
        GrSym.Properties("PenColor") = PenCol
        GrSym.Properties("PenWidth") = PenWid
        GrSym.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrSym.Properties("Thickness") = 0
        GrSym.Properties("BrushStyle") = ""
        GrSym.Cosmetic = True
    With GrSym.Vertices
        .Add 0, SizeSym, 0
        .Add 0, 0, 0
        .Add SizeSym, 0, 0
        .AddClose
    End With
End Sub

' Flange-Corner Symbol
Private Sub Flange_CornerSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)
Dim GrCh As Graphic
    Set GrSym = Gr.Graphics.Add(11)
        GrSym.Cosmetic = True
    Set GrCh = GrSym.Graphics.Add(11)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    With GrCh.Vertices
        .Add 0, SizeSym, 0
        .Add 0, 0, 0
    End With
    Set GrCh = GrSym.Graphics.Add(11)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    With GrCh.Vertices
        .Add SizeSym / 4, SizeSym, 0
        .Add SizeSym / 4, SizeSym / 2, 0
    End With
Dim xc#, yc#, R#
    xc = SizeSym / 4 + SizeSym / 2
    yc = SizeSym / 2
    R = SizeSym / 2
    Set GrCh = GrSym.Graphics.AddArcCenterAndPoint(xc, yc, 0, xc - R, yc, 0, Pi, 3 * Pi / 2)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    Set GrCh = Nothing

End Sub

' Flange-Edge Symbol
Private Sub Flange_EdgeSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)
Dim GrCh As Graphic
Dim xc#, yc#, R#
    Set GrSym = Gr.Graphics.Add(11)
        GrSym.Cosmetic = True
    Set GrCh = GrSym.Graphics.Add(11)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    With GrCh.Vertices
        .Add 0, SizeSym, 0
        .Add 0, SizeSym / 2, 0
    End With
    xc = -SizeSym / 2
    yc = SizeSym / 2
    R = SizeSym / 2
    Set GrCh = GrSym.Graphics.AddArcCenterAndPoint(xc, yc, 0, xc - R, yc, 0, 3 * Pi / 2, 2 * Pi)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0

    Set GrCh = GrSym.Graphics.Add(11)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    With GrCh.Vertices
        .Add SizeSym / 4, SizeSym, 0
        .Add SizeSym / 4, SizeSym / 2, 0
    End With
    xc = SizeSym / 4 + SizeSym / 2
    yc = SizeSym / 2
    R = SizeSym / 2
    Set GrCh = GrSym.Graphics.AddArcCenterAndPoint(xc, yc, 0, xc - R, yc, 0, Pi, 3 * Pi / 2)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    Set GrCh = Nothing

End Sub

' Flare-Bevel Symbol
Private Sub Flare_BevelSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)
Dim GrCh As Graphic
    Set GrSym = Gr.Graphics.Add(11)
        GrSym.Cosmetic = True
    Set GrCh = GrSym.Graphics.Add(11)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    With GrCh.Vertices
        .Add 0, SizeSym, 0
        .Add 0, 0, 0
    End With
Dim xc#, yc#, R#
    xc = SizeSym / 6 + SizeSym
    yc = 0
    R = SizeSym
    Set GrCh = GrSym.Graphics.AddArcCenterAndPoint(xc, yc, 0, xc - R, yc, 0, Pi / 2, Pi)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    Set GrCh = Nothing

End Sub

' Flare-V Symbol
Private Sub Flare_VSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)
Dim GrCh As Graphic
    Set GrSym = Gr.Graphics.Add(11)
        GrSym.Cosmetic = True
Dim xc#, yc#, R#
    xc = -SizeSym / 12 - SizeSym
    yc = 0
    R = SizeSym
    Set GrCh = GrSym.Graphics.AddArcCenterAndPoint(xc, yc, 0, xc - R, yc, 0, 0, Pi / 2)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0

    xc = SizeSym / 12 + SizeSym
    yc = 0
    R = SizeSym
    Set GrCh = GrSym.Graphics.AddArcCenterAndPoint(xc, yc, 0, xc - R, yc, 0, Pi / 2, Pi)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    Set GrCh = Nothing

End Sub

' J-Groove Symbol
Private Sub J_GrooveSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)
Dim GrCh As Graphic
    Set GrSym = Gr.Graphics.Add(11)
        GrSym.Cosmetic = True
    Set GrCh = GrSym.Graphics.Add(11)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    With GrCh.Vertices
        .Add 0, SizeSym, 0
        .Add 0, 0, 0
    End With
Dim xc#, yc#, R#

    xc = 0
    yc = SizeSym
    R = 0.7 * SizeSym
    Set GrCh = GrSym.Graphics.AddArcCenterAndPoint(xc, yc, 0, xc - R, yc, 0, 3 * Pi / 2, 2 * Pi)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    Set GrCh = Nothing

End Sub

' Plug Symbol
Private Sub PlugSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)
Dim GrCh As Graphic
    Set GrSym = Gr.Graphics.Add(11)
        GrSym.Cosmetic = True
        GrSym.Properties("PenColor") = PenCol
        GrSym.Properties("PenWidth") = PenWid
        GrSym.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrSym.Properties("Thickness") = 0
    With GrSym.Vertices
        .Add -0.5 * SizeSym, 0, 0
        .Add 0.5 * SizeSym, 0, 0
        .Add 0.5 * SizeSym + 0.5 * SizeSym, SizeSym, 0
        .Add -0.5 * SizeSym - 0.5 * SizeSym, SizeSym, 0
        .AddClose
    End With
    GrSym.Properties("BrushStyle") = ""

End Sub

' Scarf Symbol
Private Sub ScarfSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)
Dim GrCh As Graphic
    Set GrSym = Gr.Graphics.Add(11)
        GrSym.Cosmetic = True
    Set GrCh = GrSym.Graphics.Add(11)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    With GrCh.Vertices
        .Add -SizeSym / 6, 0, 0
        .Add SizeSym - SizeSym / 6, SizeSym, 0
    End With
Dim GrDup As Graphic
    Set GrDup = GrCh.Duplicate
    GrDup.MoveRelative SizeSym / 3, 0, 0

    Set GrCh = Nothing
    Set GrDup = Nothing

End Sub

' Seam Symbol
Private Sub SeamSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)
Dim GrCh As Graphic
    Set GrSym = Gr.Graphics.Add(11)
        GrSym.Cosmetic = True

    Set GrCh = GrSym.Graphics.AddCircleCenterAndPoint(0, 0, 0, SizeSym / 2, 0, 0)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
        GrCh.Properties("BrushStyle") = ""

    Set GrCh = GrSym.Graphics.Add(11)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    With GrCh.Vertices
        .Add -1.2 * SizeSym / 2, SizeSym / 4, 0
        .Add 1.2 * SizeSym / 2, SizeSym / 4, 0
    End With

    Set GrCh = GrSym.Graphics.Add(11)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    With GrCh.Vertices
        .Add -1.2 * SizeSym / 2, -SizeSym / 4, 0
        .Add 1.2 * SizeSym / 2, -SizeSym / 4, 0
    End With

    GrSym.MoveRelative 0, SizeSym / 2, 0

    Set GrCh = Nothing

End Sub

' Slot Symbol
Private Sub SlotSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)
Dim GrCh As Graphic
    Set GrSym = Gr.Graphics.Add(11)
        GrSym.Properties("PenColor") = PenCol
        GrSym.Properties("PenWidth") = PenWid
        GrSym.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrSym.Properties("Thickness") = 0
        GrSym.Cosmetic = True
    With GrSym.Vertices
        .Add -0.8 * SizeSym, 0, 0
        .Add 0.8 * SizeSym, 0, 0
        .Add 0.8 * SizeSym, SizeSym, 0
        .Add -0.8 * SizeSym, SizeSym, 0
        .AddClose
    End With
    GrSym.Properties("BrushStyle") = ""

End Sub

' Spot/Projection Symbol
Private Sub Spot_ProjectionSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)
Dim GrCh As Graphic
    Set GrSym = Gr.Graphics.AddCircleCenterAndPoint(0, 0, 0, SizeSym / 2, 0, 0)
        GrSym.Properties("PenColor") = PenCol
        GrSym.Properties("PenWidth") = PenWid
        GrSym.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrSym.Properties("Thickness") = 0
        GrSym.Cosmetic = True
        GrSym.Properties("BrushStyle") = ""

    GrSym.MoveRelative 0, SizeSym / 2, 0

End Sub

' Square Symbol
Private Sub SquareSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)
Dim GrCh As Graphic
    Set GrSym = Gr.Graphics.Add(11)
        GrSym.Cosmetic = True

    Set GrCh = GrSym.Graphics.Add(11)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    With GrCh.Vertices
        .Add -SizeSym / 6, SizeSym, 0
        .Add -SizeSym / 6, 0, 0
    End With
Dim GrDup As Graphic
    Set GrDup = GrCh.Duplicate
    GrDup.MoveRelative SizeSym / 3, 0, 0

    Set GrCh = Nothing
    Set GrDup = Nothing

End Sub

' Surfacing Symbol
Private Sub SurfacingSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)
Dim GrCh As Graphic
    Set GrSym = Gr.Graphics.Add(11)
        GrSym.Cosmetic = True

    Set GrCh = GrSym.Graphics.AddArcTriplePoint(0, 0, 0, 0.4 * SizeSym, 0.3 * SizeSym, 0, 0.8 * SizeSym, 0, 0)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
Dim GrDup As Graphic
    Set GrDup = GrCh.Duplicate
    GrDup.MoveRelative -0.8 * SizeSym, 0, 0

    Set GrCh = Nothing
    Set GrDup = Nothing

End Sub

' U-Groove Symbol
Private Sub U_GrooveSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)
Dim GrCh As Graphic
    Set GrSym = Gr.Graphics.Add(11)
        GrSym.Cosmetic = True

'    Set GrCh = GrSym.Graphics.AddArcTriplePoint(-SizeSym / 2 - SizeSym / 4, SizeSym + SizeSym / 4, 0, 0, 0.4 * SizeSym, 0, SizeSym / 2 + SizeSym / 4, SizeSym + SizeSym / 4, 0)
    Set GrCh = GrSym.Graphics.AddArcElliptical(-3 * SizeSym / 4, SizeSym + 2 * SizeSym / 3, 0, 3 * SizeSym / 4, SizeSym - 2 * SizeSym / 3, 0, Pi, 2 * Pi)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0

    Set GrCh = GrSym.Graphics.Add(11)
        GrCh.Properties("PenColor") = PenCol
        GrCh.Properties("PenWidth") = PenWid
        GrCh.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrCh.Properties("Thickness") = 0
    With GrCh.Vertices
        .Add 0, SizeSym / 3, 0
        .Add 0, 0, 0
    End With

End Sub

' V-Groove Symbol
Private Sub V_GrooveSymbol(Gr As Graphic, GrSym As Graphic, SizeSym As Double)
Dim GrCh As Graphic
    Set GrSym = Gr.Graphics.Add(11)
        GrSym.Properties("PenColor") = PenCol
        GrSym.Properties("PenWidth") = PenWid
        GrSym.Properties("PenStyle") = "CONTINUOUS"
        On Error Resume Next
        GrSym.Properties("Thickness") = 0
        GrSym.Cosmetic = True
    With GrSym.Vertices
        .Add -0.8 * SizeSym, 0.8 * SizeSym, 0
        .Add 0, 0, 0
        .Add 0.8 * SizeSym, 0.8 * SizeSym, 0
    End With
End Sub

' Form string from string with symbols
Private Function StringToSize(Str As String) As Double
Dim CharInt(10) As String, j%
    CharInt(0) = "0"
    CharInt(1) = "1"
    CharInt(2) = "2"
    CharInt(3) = "3"
    CharInt(4) = "4"
    CharInt(5) = "5"
    CharInt(6) = "6"
    CharInt(7) = "7"
    CharInt(8) = "8"
    CharInt(9) = "9"
Dim StrLen%, i%
Dim Char$, ResStr$
    ResStr = ""
    StrLen = Len(Str)
Dim NumPoints%
    NumPoints = 0
    For i = 1 To StrLen
        Char = VBA.Mid(Str, i, 1)
        If Char = "0" Or Char = "1" Or Char = "2" Or Char = "3" Or Char = "4" Or Char = "5" Or Char = "6" Or Char = "7" Or Char = "8" Or Char = "9" Or Char = "." Or Char = "," Then
            If Char = "," Then Char = "."
            If Char = "." Then NumPoints = NumPoints + 1
            If NumPoints > 1 Then Exit For
            ResStr = ResStr & Char
        End If
    Next i
    StringToSize = CDbl(ResStr)
End Function

'Calculate the Units scale if it changes

Private Function UnitToUnit(UnitName As String, UnitNameOld As String) As Double
    UnitToUnit = 1
'MsgBox ("UnitNameOld=" & UnitNameOld & "   UnitNameNew=" & UnitName)
    If UnitNameOld = "in" Or UnitNameOld = """" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 1
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 1 / 12
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 1 / 36
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 1 / (12 * 5280)
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 25.4
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 2.54
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 2.54 / 100
            Exit Function
        End If
    End If

    If UnitNameOld = "ft" Or UnitNameOld = "'" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 12
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 1
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 1 / 3
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 1 / 5280
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 12 * 25.4
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 12 * 2.54
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 12 * 2.54 / 100
            Exit Function
        End If
    End If

    If UnitNameOld = "yd" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 3 * 12
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 3
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 1
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 1 / 5280 / 3
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 3 * 12 * 25.4
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 3 * 12 * 2.54
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 3 * 12 * 2.54 / 100
            Exit Function
        End If
    End If
' Add Miles

    If UnitNameOld = "mm" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 1 / 25.4
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 1 / 25.4 / 12
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 1 / 25.4 / 12 / 3
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 1 / 25.4 / 12 / 5280
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 1
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 1 / 10
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 1 / 1000
            Exit Function
        End If
    End If

    If UnitNameOld = "cm" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 1 / 2.54
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 1 / 2.54 / 12
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 1 / 2.54 / 12 / 3
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 1 / 2.54 / 12 / 5280
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 10
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 1
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 1 / 100
            Exit Function
        End If
    End If

    If UnitNameOld = "m" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 1000 / 25.4
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 1000 / 25.4 / 12
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 1000 / 25.4 / 12 / 3
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 1000 / 25.4 / 12 / 5280
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 1000
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 100
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 1
            Exit Function
        End If
    End If
        UnitToUnit = 1

End Function

Private Sub AddStringWithDiv(Gr As Graphic, GrCh As Graphic, Str$, hText#)
Dim Num(9) As String
    Num(0) = "0"
    Num(1) = "1"
    Num(2) = "2"
    Num(3) = "3"
    Num(4) = "4"
    Num(5) = "5"
    Num(6) = "6"
    Num(7) = "7"
    Num(8) = "8"
    Num(9) = "9"
Dim StrLen%, i%, j%, k%, m%
    StrLen = VBA.Len(Str)
Dim DividerExist As Boolean
    DividerExist = False
Dim IndDiv(4) As Integer
Dim NumDiv%
    NumDiv = 0
Dim Char$
    For i = 1 To StrLen
        Char = VBA.Mid(Str, i, 1)
        If Char = "/" Then
            NumDiv = NumDiv + 1
            IndDiv(NumDiv) = i
            DividerExist = True
        End If
    Next i
Dim GrText As Graphic
Dim GrDiv As Graphic

    If DividerExist = False Then
        Set GrText = GrCh.Graphics.AddText(Str, 0, 0, 0, hText)
        GrText.Properties("PenColor") = PenCol
        Set GrText = Nothing
        Exit Sub
    End If

Dim iDiv%
Dim StrTop$, StrBot$
Dim IsNum As Boolean
Dim Pref$, Suf$
Dim xi#, wText#
    xi = 0

    For i = 1 To NumDiv
        iDiv = IndDiv(i)
        StrTop = ""
        StrBot = ""
        Pref = ""
        For j = iDiv - 1 To 1 Step -1
            Char = VBA.Mid(Str, j, 1)
            IsNum = False
            For k = 0 To 9
                If Char = Num(k) Then
                    IsNum = True
                    Exit For
                End If
            Next k
            If IsNum = True Then
                StrTop = Char & StrTop
            Else ' Define prefix
                For m = j To 1 Step -1
                    Char = VBA.Mid(Str, m, 1)
                    IsNum = False
                    For k = 0 To 9
                        If Char = Num(k) Then
                            IsNum = True
                            Exit For
                        End If
                    Next k
                    If IsNum = False Then
                        Pref = Char & Pref
                    Else
                        GoTo BOT
                    End If
                Next m
                GoTo BOT
            End If
        Next j
BOT:
        For j = iDiv + 1 To StrLen
            Char = VBA.Mid(Str, j, 1)
            IsNum = False
            For k = 0 To 9
                If Char = Num(k) Then
                    IsNum = True
                    Exit For
                End If
            Next k
            If IsNum = True Then
                StrBot = StrBot & Char
            Else
                Exit For
            End If
        Next j
Dim jk%
        jk = j
        If Pref <> "" Then
            Set GrText = GrCh.Graphics.AddText(Pref, xi, hText / 2, 0, hText)
            GrText.Properties("PenColor") = PenCol
            With GrText.CalcBoundingBox
                wText = .Max.x - .Min.x
            End With
            xi = xi + wText
        End If
        Set GrText = GrCh.Graphics.AddText(StrBot, xi, 0, 0, hText)
        GrText.Properties("PenColor") = PenCol
        Set GrText = GrCh.Graphics.AddText(StrTop, xi, hText, 0, hText)
        GrText.Properties("PenColor") = PenCol
        With GrText.CalcBoundingBox
            wText = .Max.x - .Min.x
        End With
        Set GrDiv = GrCh.Graphics.AddLineSingle(xi, 0, 0, xi + wText, 0, 0)
        GrDiv.Properties("PenColor") = PenCol
        xi = xi + wText

        Suf = ""
        If i = NumDiv Then
            For j = jk To StrLen
                Char = VBA.Mid(Str, j, 1)
                Suf = Suf & Char
            Next j
            If Suf <> "" Then
                Set GrText = GrCh.Graphics.AddText(Suf, xi, hText / 2, 0, hText)
                GrText.Properties("PenColor") = PenCol
                Exit For
            End If
        End If
    Next i

End Sub

Private Function NumToFractString(x As Double) As String
Dim xInt%, xFrac#
Dim y#
Dim Str$
Dim i%, j%, iLast%
    iLast = 100
Dim Div() As Integer
Dim iDiv As Integer
    iDiv = 0

    If x >= 1 Then
        xInt = VBA.Int(x)
        xFrac = x - xInt
        j = 2
MM1:
        For i = j To iLast
            y = xFrac * i
            If y >= 1 Then Exit For
        Next i
        If i = iLast + 1 Then GoTo LL1
ReDim Preserve Div(iDiv)
        Div(iDiv) = i
        iDiv = iDiv + 1
        j = i
        xFrac = xFrac - 1 / i
        GoTo MM1
LL1:
Dim xNew#
Dim a#, b#, aa#, bb#
        a = 0
        b = 1
        For i = 0 To iDiv - 1
            aa = 1
            For j = 0 To iDiv - 1
                aa = aa * Div(j)
            Next j
            aa = aa / Div(i)
            a = a + aa
        Next i

        For i = 0 To iDiv - 1
            b = b * Div(i)
        Next i
        xNew = a / b
NN1:
        For i = 2 To 99
            aa = a / i
            bb = b / i
            If Abs(aa - Int(aa)) < Eps And Abs(bb - Int(bb)) < Eps Then
                a = Int(aa)
                b = Int(bb)
                GoTo NN1
            End If
        Next i
        If a <> 0 Then
            Str = CStr(xInt) & " " & CStr(a) & "/" & CStr(b)
        Else
            Str = CStr(xInt)
        End If
    Else
        xFrac = x
        j = 2
MM:
        For i = j To iLast
            y = xFrac * i
            If y >= 1 Then Exit For
        Next i
        If i = iLast + 1 Then GoTo LL
ReDim Preserve Div(iDiv)
        Div(iDiv) = i
        iDiv = iDiv + 1
        j = i
        xFrac = xFrac - 1 / i
        GoTo MM
LL:
        a = 0
        b = 1
        For i = 0 To iDiv - 1
            aa = 1
            For j = 0 To iDiv - 1
                aa = aa * Div(j)
            Next j
            aa = aa / Div(i)
            a = a + aa
        Next i

        For i = 0 To iDiv - 1
            b = b * Div(i)
        Next i
        xNew = a / b
NN:
        For i = 2 To 99
            aa = a / i
            bb = b / i
            If Abs(aa - Int(aa)) < Eps And Abs(bb - Int(bb)) < Eps Then
                a = Int(aa)
                b = Int(bb)
                GoTo NN
            End If
        Next i
        Str = CStr(a) & "/" & CStr(b)

    End If

    NumToFractString = Str
End Function

Private Function FractStringToNum(Str As String) As Double
Dim Num(9) As String
    Num(0) = "0"
    Num(1) = "1"
    Num(2) = "2"
    Num(3) = "3"
    Num(4) = "4"
    Num(5) = "5"
    Num(6) = "6"
    Num(7) = "7"
    Num(8) = "8"
    Num(9) = "9"
Dim StrLen%, i%, j%, k%, m%
    StrLen = VBA.Len(Str)
Dim DividerExist As Boolean
    DividerExist = False
Dim IndDiv As Integer
Dim NumDiv%
    NumDiv = 0
Dim Char$
    For i = 1 To StrLen
        Char = VBA.Mid(Str, i, 1)
        If Char = "/" Then
            NumDiv = NumDiv + 1
            IndDiv = i
            DividerExist = True
        End If
    Next i

    If DividerExist = False Then
        Exit Function
    End If

Dim iDiv%
Dim StrTop$, StrBot$
Dim IsNum As Boolean
Dim Pref$
Dim xi#, wText#
    xi = 0

        iDiv = IndDiv
        StrTop = ""
        StrBot = ""
        Pref = ""
        For j = iDiv - 1 To 1 Step -1
            Char = VBA.Mid(Str, j, 1)
            IsNum = False
            For k = 0 To 9
                If Char = Num(k) Then
                    IsNum = True
                    Exit For
                End If
            Next k
            If IsNum = True Then
                StrTop = Char & StrTop
            Else ' Define prefix
                For m = j To 1 Step -1
                    Char = VBA.Mid(Str, m, 1)
                    IsNum = False
                    For k = 0 To 9
                        If Char = Num(k) Then
                            IsNum = True
                            Exit For
                        End If
                    Next k
                    If IsNum = True Then
                        Pref = Char & Pref
                    End If
                Next m
                GoTo BOT
            End If
        Next j
BOT:
        For j = iDiv + 1 To StrLen
            Char = VBA.Mid(Str, j, 1)
            IsNum = False
            For k = 0 To 9
                If Char = Num(k) Then
                    IsNum = True
                    Exit For
                End If
            Next k
            If IsNum = True Then
                StrBot = StrBot & Char
            End If
        Next j

Dim x#, a#, b#, c#
        x = 0
        a = 0
        b = 0
        c = 0
        If Pref <> "" Then
            a = CDbl(Pref)
        End If
        If StrTop <> "" Then
            b = CDbl(StrTop)
        End If
        If StrBot <> "" Then
            c = CDbl(StrBot)
        End If
        If c <> 0 Then
            x = a + b / c
        End If

        FractStringToNum = x

End Function


Examples - Welding Symbol Regen - Weld.frm

Weld.frm

Welding Symbol Regen Example

VERSION 5.00
Begin VB.Form frmWeld
   Caption         =   "Weld Symbol"
   ClientHeight    =   6105
   ClientLeft      =   6435
   ClientTop       =   2910
   ClientWidth     =   6990
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6105
   ScaleWidth      =   6990
   Begin VB.CommandButton TailText1
      Caption         =   "Tail reference"
      Height          =   372
      Left            =   120
      TabIndex        =   25
      ToolTipText     =   "Specification,process and other reference."
      Top             =   3120
      Width           =   1212
   End
   Begin VB.CommandButton TailText
      Caption         =   "Tail reference"
      Height          =   372
      Left            =   5520
      TabIndex        =   24
      ToolTipText     =   "Specification,process and other reference."
      Top             =   3120
      Width           =   1332
   End
   Begin VB.TextBox Size_TrBot1
      Height          =   288
      Left            =   2040
      TabIndex        =   18
      ToolTipText     =   "Depth of Chamfer. Root Penetration."
      Top             =   4080
      Width           =   1092
   End
   Begin VB.TextBox Size_TrBot
      Height          =   288
      Left            =   2040
      TabIndex        =   16
      ToolTipText     =   "Depth of Chamfer. Root Penetration."
      Top             =   3600
      Width           =   1092
   End
   Begin VB.TextBox Size_TrTop1
      Height          =   288
      Left            =   2040
      TabIndex        =   10
      ToolTipText     =   "Depth of Chamfer. Root Penetration."
      Top             =   2400
      Width           =   1092
   End
   Begin VB.TextBox Size_TrTop
      Height          =   288
      Left            =   2040
      TabIndex        =   8
      ToolTipText     =   "Depth of Chamfer. Root Penetration."
      Top             =   2880
      Width           =   1092
   End
   Begin VB.TextBox Len_PitBot
      Height          =   288
      Left            =   3720
      TabIndex        =   17
      ToolTipText     =   "Length - Pitch"
      Top             =   3480
      Width           =   1092
   End
   Begin VB.TextBox Len_PitTop
      Height          =   288
      Left            =   3720
      TabIndex        =   9
      ToolTipText     =   "Length - Pitch"
      Top             =   3000
      Width           =   1092
   End
   Begin VB.TextBox LeaderSize
      Height          =   288
      Left            =   5640
      TabIndex        =   7
      Text            =   "0.25"
      ToolTipText     =   "Leader size"
      Top             =   960
      Visible         =   0   'False
      Width           =   972
   End
   Begin VB.CheckBox Intermittent
      Caption         =   "Staggered Fillet"
      Height          =   252
      Left            =   120
      TabIndex        =   5
      ToolTipText     =   "Staggeted for Filletweld"
      Top             =   1320
      Width           =   1452
   End
   Begin VB.CheckBox Direction
      Caption         =   "Direction (right/left)"
      Height          =   252
      Left            =   120
      TabIndex        =   4
      ToolTipText     =   "Direction of Weld symbol"
      Top             =   1080
      Value           =   1  'Checked
      Width           =   1692
   End
   Begin VB.CheckBox Leader
      Caption         =   "Leader (straight/broken)"
      Height          =   252
      Left            =   120
      TabIndex        =   3
      ToolTipText     =   "Leader (straight or broken)"
      Top             =   840
      Width           =   2052
   End
   Begin VB.ComboBox FinishBot
      Height          =   288
      Left            =   2880
      TabIndex        =   23
      ToolTipText     =   "Finish symbol"
      Top             =   5640
      Width           =   1212
   End
   Begin VB.ComboBox FinishTop
      Height          =   288
      Left            =   2880
      TabIndex        =   15
      ToolTipText     =   "Finish symbol"
      Top             =   360
      Width           =   1212
   End
   Begin VB.ComboBox ContourBot
      Height          =   288
      Left            =   2880
      TabIndex        =   22
      ToolTipText     =   "Contour symbol"
      Top             =   5280
      Width           =   1212
   End
   Begin VB.ComboBox ContourTop
      Height          =   288
      Left            =   2880
      TabIndex        =   14
      ToolTipText     =   "Contour symbol"
      Top             =   720
      Width           =   1212
   End
   Begin VB.ComboBox DegBot
      Height          =   288
      Left            =   3600
      TabIndex        =   21
      ToolTipText     =   "Degree Symbol"
      Top             =   4920
      Width           =   492
   End
   Begin VB.ComboBox DegTop
      Height          =   288
      Left            =   3600
      TabIndex        =   13
      ToolTipText     =   "Degree Symbol"
      Top             =   1080
      Width           =   492
   End
   Begin VB.TextBox Fill_DepthBot
      Height          =   288
      Left            =   2880
      TabIndex        =   19
      ToolTipText     =   "Root Opening"
      Top             =   4560
      Width           =   1212
   End
   Begin VB.TextBox Fill_DepthTop
      Height          =   288
      Left            =   2880
      TabIndex        =   11
      ToolTipText     =   "Depth of penetration"
      Top             =   1440
      Width           =   1212
   End
   Begin VB.TextBox HeightText
      Height          =   288
      Left            =   5640
      TabIndex        =   6
      Text            =   "0.25"
      ToolTipText     =   "Symbol size"
      Top             =   360
      Width           =   972
   End
   Begin VB.CheckBox Check3
      Caption         =   "Tail "
      Height          =   252
      Left            =   120
      TabIndex        =   2
      ToolTipText     =   "Tail symbol"
      Top             =   600
      Width           =   612
   End
   Begin VB.CheckBox Check2
      Caption         =   "Field "
      Height          =   252
      Left            =   120
      TabIndex        =   1
      ToolTipText     =   "Field symbol"
      Top             =   360
      Width           =   732
   End
   Begin VB.CheckBox Check1
      Caption         =   "All around "
      Height          =   252
      Left            =   120
      TabIndex        =   0
      ToolTipText     =   "All around symbol"
      Top             =   120
      Width           =   1092
   End
   Begin VB.TextBox Gr_AngleBot
      Height          =   288
      Left            =   2880
      TabIndex        =   20
      ToolTipText     =   "Groove Angle"
      Top             =   4920
      Width           =   732
   End
   Begin VB.TextBox Gr_AngleTop
      Height          =   288
      Left            =   2880
      TabIndex        =   12
      ToolTipText     =   "Groove Angle"
      Top             =   1080
      Width           =   732
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   480
      TabIndex        =   26
      Top             =   4800
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   480
      TabIndex        =   27
      Top             =   5400
      Width           =   1215
   End
   Begin VB.Label Units
      AutoSize        =   -1  'True
      BackColor       =   &H00C0C0C0&
      Caption         =   " in "
      Height          =   192
      Left            =   6600
      TabIndex        =   41
      Top             =   396
      Width           =   192
   End
   Begin VB.Label Label15
      Caption         =   "Root Penetration"
      Height          =   252
      Left            =   1920
      TabIndex        =   40
      Top             =   2100
      Width           =   1212
   End
   Begin VB.Label Label14
      AutoSize        =   -1  'True
      Caption         =   "Leader size"
      Height          =   192
      Left            =   5640
      TabIndex        =   39
      Top             =   720
      Visible         =   0   'False
      Width           =   840
   End
   Begin VB.Line Line30
      BorderWidth     =   2
      X1              =   5400
      X2              =   5520
      Y1              =   4080
      Y2              =   4200
   End
   Begin VB.Line Line29
      BorderWidth     =   2
      X1              =   5280
      X2              =   5520
      Y1              =   4320
      Y2              =   4200
   End
   Begin VB.Line Line28
      BorderWidth     =   2
      X1              =   5280
      X2              =   5400
      Y1              =   4320
      Y2              =   4080
   End
   Begin VB.Line Line27
      BorderWidth     =   2
      X1              =   5760
      X2              =   5460
      Y1              =   3840
      Y2              =   4140
   End
   Begin VB.Line Line26
      BorderWidth     =   2
      X1              =   5280
      X2              =   5760
      Y1              =   3360
      Y2              =   3840
   End
   Begin VB.Line Line25
      BorderWidth     =   2
      X1              =   6120
      X2              =   6240
      Y1              =   4320
      Y2              =   4200
   End
   Begin VB.Line Line24
      BorderWidth     =   2
      X1              =   6360
      X2              =   6240
      Y1              =   4440
      Y2              =   4200
   End
   Begin VB.Line Line23
      BorderWidth     =   2
      X1              =   6360
      X2              =   6120
      Y1              =   4440
      Y2              =   4320
   End
   Begin VB.Line Line22
      BorderWidth     =   2
      X1              =   5280
      X2              =   6180
      Y1              =   3360
      Y2              =   4260
   End
   Begin VB.Line Line21
      BorderWidth     =   2
      X1              =   1560
      X2              =   1440
      Y1              =   3360
      Y2              =   3480
   End
   Begin VB.Line Line20
      BorderWidth     =   2
      X1              =   1560
      X2              =   1440
      Y1              =   3360
      Y2              =   3240
   End
   Begin VB.Line Line19
      BorderWidth     =   2
      X1              =   5640
      X2              =   5280
      Y1              =   2520
      Y2              =   2640
   End
   Begin VB.Line Line18
      BorderWidth     =   2
      X1              =   5280
      X2              =   5640
      Y1              =   2400
      Y2              =   2520
   End
   Begin VB.Line Line17
      BorderWidth     =   2
      X1              =   5280
      X2              =   5280
      Y1              =   3360
      Y2              =   2400
   End
   Begin VB.Shape Shape2
      BorderWidth     =   2
      Height          =   252
      Left            =   5160
      Shape           =   3  'Circle
      Top             =   3240
      Width           =   252
   End
   Begin VB.Line Line16
      BorderWidth     =   2
      X1              =   1320
      X2              =   1440
      Y1              =   4200
      Y2              =   4080
   End
   Begin VB.Line Line15
      BorderWidth     =   2
      X1              =   1560
      X2              =   1440
      Y1              =   4320
      Y2              =   4080
   End
   Begin VB.Line Line14
      BorderWidth     =   2
      X1              =   1560
      X2              =   1320
      Y1              =   4320
      Y2              =   4200
   End
   Begin VB.Line Line13
      BorderWidth     =   2
      X1              =   1080
      X2              =   1380
      Y1              =   3840
      Y2              =   4140
   End
   Begin VB.Line Line12
      BorderWidth     =   2
      X1              =   1560
      X2              =   1080
      Y1              =   3360
      Y2              =   3840
   End
   Begin VB.Line Line11
      BorderWidth     =   2
      X1              =   600
      X2              =   720
      Y1              =   4200
      Y2              =   4320
   End
   Begin VB.Line Line7
      BorderWidth     =   2
      X1              =   480
      X2              =   720
      Y1              =   4440
      Y2              =   4320
   End
   Begin VB.Line Line6
      BorderWidth     =   2
      X1              =   480
      X2              =   600
      Y1              =   4440
      Y2              =   4200
   End
   Begin VB.Image ImageBot1
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   3240
      Stretch         =   -1  'True
      Top             =   4020
      Width           =   372
   End
   Begin VB.Image ImageTop1
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   3240
      Stretch         =   -1  'True
      Top             =   2340
      Width           =   372
   End
   Begin VB.Label Label12
      AutoSize        =   -1  'True
      Caption         =   "Finish"
      Height          =   192
      Left            =   4200
      TabIndex        =   38
      Top             =   5640
      Width           =   420
   End
   Begin VB.Label Label11
      AutoSize        =   -1  'True
      Caption         =   "Finish"
      Height          =   192
      Left            =   4200
      TabIndex        =   37
      Top             =   360
      Width           =   420
   End
   Begin VB.Label Label10
      AutoSize        =   -1  'True
      Caption         =   "Contour"
      Height          =   192
      Left            =   4200
      TabIndex        =   36
      Top             =   5280
      Width           =   552
   End
   Begin VB.Label Label9
      AutoSize        =   -1  'True
      Caption         =   "Contour"
      Height          =   192
      Left            =   4200
      TabIndex        =   35
      Top             =   720
      Width           =   552
   End
   Begin VB.Label Label8
      AutoSize        =   -1  'True
      Caption         =   "Groove angle"
      Height          =   192
      Left            =   4200
      TabIndex        =   34
      Top             =   4920
      Width           =   984
   End
   Begin VB.Label Label7
      AutoSize        =   -1  'True
      Caption         =   "Root Opening"
      Height          =   192
      Left            =   4200
      TabIndex        =   33
      Top             =   4560
      Width           =   996
   End
   Begin VB.Label Label6
      AutoSize        =   -1  'True
      Caption         =   "Root Opening"
      Height          =   192
      Left            =   4200
      TabIndex        =   32
      Top             =   1440
      Width           =   996
   End
   Begin VB.Label Label5
      AutoSize        =   -1  'True
      Caption         =   "Groove angle"
      Height          =   192
      Left            =   4200
      TabIndex        =   31
      Top             =   1080
      Width           =   984
   End
   Begin VB.Label Label4
      AutoSize        =   -1  'True
      Caption         =   "Depth of Chamfer"
      Height          =   192
      Left            =   1920
      TabIndex        =   30
      Top             =   1860
      Width           =   1236
   End
   Begin VB.Label Label3
      AutoSize        =   -1  'True
      Caption         =   "Length-Pitch"
      Height          =   192
      Left            =   3720
      TabIndex        =   29
      Top             =   2760
      Width           =   876
   End
   Begin VB.Label Label1
      AutoSize        =   -1  'True
      Caption         =   "Symbol size"
      Height          =   192
      Left            =   5640
      TabIndex        =   28
      Top             =   120
      Width           =   876
   End
   Begin VB.Line Line10
      BorderWidth     =   2
      X1              =   1560
      X2              =   1920
      Y1              =   2640
      Y2              =   2520
   End
   Begin VB.Line Line9
      BorderWidth     =   2
      X1              =   1560
      X2              =   1920
      Y1              =   2400
      Y2              =   2520
   End
   Begin VB.Line Line8
      BorderWidth     =   2
      X1              =   1560
      X2              =   1560
      Y1              =   3360
      Y2              =   2400
   End
   Begin VB.Shape Shape1
      BorderWidth     =   2
      Height          =   252
      Left            =   1440
      Shape           =   3  'Circle
      Top             =   3240
      Width           =   252
   End
   Begin VB.Line Line5
      BorderWidth     =   2
      X1              =   3600
      X2              =   5280
      Y1              =   3360
      Y2              =   3360
   End
   Begin VB.Image ImageBot
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   3240
      Stretch         =   -1  'True
      ToolTipText     =   "Arrow side Symbol"
      Top             =   3600
      Width           =   372
   End
   Begin VB.Image ImageTop
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   3240
      Stretch         =   -1  'True
      ToolTipText     =   "Other side Symbol"
      Top             =   2760
      Width           =   372
   End
   Begin VB.Image ImageMid
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   3240
      Stretch         =   -1  'True
      ToolTipText     =   "Middle Symbol"
      Top             =   3180
      Width           =   372
   End
   Begin VB.Line Line2
      BorderWidth     =   2
      X1              =   1560
      X2              =   3240
      Y1              =   3360
      Y2              =   3360
   End
   Begin VB.Line Line4
      BorderWidth     =   2
      X1              =   5280
      X2              =   5400
      Y1              =   3360
      Y2              =   3480
   End
   Begin VB.Line Line3
      BorderWidth     =   2
      X1              =   5280
      X2              =   5400
      Y1              =   3360
      Y2              =   3240
   End
   Begin VB.Line Line1
      BorderWidth     =   2
      X1              =   660
      X2              =   1560
      Y1              =   4260
      Y2              =   3360
   End
End
Attribute VB_Name = "frmWeld"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean
' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub Check1_Click()
    If Check1.Value > 0 Then
        If Direction.Value > 0 Then
            Shape1.Visible = True
            Shape2.Visible = False
        Else
            Shape1.Visible = False
            Shape2.Visible = True
        End If
    Else
        Shape1.Visible = False
        Shape2.Visible = False
    End If

End Sub

Private Sub Check2_Click()
    If Check2.Value > 0 Then
        If Direction.Value > 0 Then
            Line8.Visible = True
            Line9.Visible = True
            Line10.Visible = True

            Line17.Visible = False
            Line18.Visible = False
            Line19.Visible = False
        Else
            Line8.Visible = False
            Line9.Visible = False
            Line10.Visible = False

            Line17.Visible = True
            Line18.Visible = True
            Line19.Visible = True
        End If
    Else
        Line8.Visible = False
        Line9.Visible = False
        Line10.Visible = False

        Line17.Visible = False
        Line18.Visible = False
        Line19.Visible = False
    End If

End Sub
Private Sub Check3_Click()
    If Check3.Value > 0 Then
        If Direction.Value > 0 Then
            Line3.Visible = True
            Line4.Visible = True
            TailText.Visible = True
'            Label2.Visible = True

            Line20.Visible = False
            Line21.Visible = False
            TailText1.Visible = False
'            Label13.Visible = False
        Else
            Line3.Visible = False
            Line4.Visible = False
            TailText.Visible = False
'            Label2.Visible = False

            Line20.Visible = True
            Line21.Visible = True
            TailText1.Visible = True
'            Label13.Visible = True
        End If
    Else
        Line3.Visible = False
        Line4.Visible = False
        TailText.Visible = False
'        Label2.Visible = False
        TailText1.Visible = False
'        Label13.Visible = False

        Line20.Visible = False
        Line21.Visible = False
    End If

End Sub

Private Sub CmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    blnDialogCanceled = True

    Me.Hide
End Sub

Private Sub CmdOK_Click()
    blnDialogCanceled = False
    Me.Hide
End Sub

Private Sub Direction_Click()
    If Direction.Value > 0 Then
        ' Around symbol
        If Check1.Value > 0 Then
            Shape1.Visible = True
        Else
            Shape1.Visible = False
        End If
        Shape2.Visible = False

        ' Field Simbol
        If Check2.Value > 0 Then
            Line8.Visible = True
            Line9.Visible = True
            Line10.Visible = True
        Else
            Line8.Visible = False
            Line9.Visible = False
            Line10.Visible = False
        End If
        Line17.Visible = False
        Line18.Visible = False
        Line19.Visible = False

        ' Tail symbol
        If Check3.Value > 0 Then
            Line3.Visible = True
            Line4.Visible = True
            TailText.Visible = True
'            TailText.Text = TailText1.Text
'            Label2.Visible = True
        Else
            Line3.Visible = False
            Line4.Visible = False
            TailText.Visible = False
'            Label2.Visible = False
        End If
        Line20.Visible = False
        Line21.Visible = False
        TailText1.Visible = False
'        Label13.Visible = False

        ' Leader symbol
        If Leader.Value > 0 Then
            Line1.Visible = True
            Line6.Visible = True
            Line7.Visible = True
            Line11.Visible = True

            Line12.Visible = False
            Line13.Visible = False
            Line14.Visible = False
            Line15.Visible = False
            Line16.Visible = False
        Else
            Line1.Visible = False
            Line6.Visible = False
            Line7.Visible = False
            Line11.Visible = False

            Line12.Visible = True
            Line13.Visible = True
            Line14.Visible = True
            Line15.Visible = True
            Line16.Visible = True
        End If
        Line22.Visible = False
        Line23.Visible = False
        Line24.Visible = False
        Line25.Visible = False

        Line26.Visible = False
        Line27.Visible = False
        Line28.Visible = False
        Line29.Visible = False
        Line30.Visible = False
    End If

    If Direction.Value = 0 Then
        ' Around symbol
        If Check1.Value > 0 Then
            Shape2.Visible = True
        Else
            Shape2.Visible = False
        End If
        Shape1.Visible = False

        ' Field Simbol
        If Check2.Value > 0 Then
            Line17.Visible = True
            Line18.Visible = True
            Line19.Visible = True
        Else
            Line17.Visible = False
            Line18.Visible = False
            Line19.Visible = False
        End If
        Line8.Visible = False
        Line9.Visible = False
        Line10.Visible = False

        ' Tail symbol
        If Check3.Value > 0 Then
            Line20.Visible = True
            Line21.Visible = True
            TailText1.Visible = True
'            TailText1.Text = TailText.Text
'            Label13.Visible = True

        Else
            Line20.Visible = False
            Line21.Visible = False
            TailText1.Visible = False
'            Label13.Visible = False
        End If
        Line3.Visible = False
        Line4.Visible = False
        TailText.Visible = False
'        Label2.Visible = False

        ' Leader symbol
        If Leader.Value > 0 Then
            Line22.Visible = True
            Line23.Visible = True
            Line24.Visible = True
            Line25.Visible = True

            Line26.Visible = False
            Line27.Visible = False
            Line28.Visible = False
            Line29.Visible = False
            Line30.Visible = False
        Else
            Line22.Visible = False
            Line23.Visible = False
            Line24.Visible = False
            Line25.Visible = False

            Line26.Visible = True
            Line27.Visible = True
            Line28.Visible = True
            Line29.Visible = True
            Line30.Visible = True
        End If
        Line1.Visible = False
        Line6.Visible = False
        Line7.Visible = False
        Line11.Visible = False

        Line12.Visible = False
        Line13.Visible = False
        Line14.Visible = False
        Line15.Visible = False
        Line16.Visible = False
    End If

End Sub

Private Sub Form_Load()
    blnDialogCanceled = True
    If Check1.Value > 0 Then
        Shape1.Visible = True
    Else
        Shape1.Visible = False
    End If

    If Check2.Value > 0 Then
        Line8.Visible = True
        Line9.Visible = True
        Line10.Visible = True
    Else
        Line8.Visible = False
        Line9.Visible = False
        Line10.Visible = False
    End If

    If Check3.Value > 0 Then
        Line3.Visible = True
        Line4.Visible = True
    Else
        Line3.Visible = False
        Line4.Visible = False
    End If

    If Leader.Value > 0 Then
        Line1.Visible = True
        Line6.Visible = True
        Line7.Visible = True
        Line11.Visible = True

        Line12.Visible = False
        Line13.Visible = False
        Line14.Visible = False
        Line15.Visible = False
        Line16.Visible = False
    Else
        Line1.Visible = False
        Line6.Visible = False
        Line7.Visible = False
        Line11.Visible = False

        Line12.Visible = True
        Line13.Visible = True
        Line14.Visible = True
        Line15.Visible = True
        Line16.Visible = True
    End If

    If Direction.Value > 0 Then

        ' Around symbol
        If Check1.Value > 0 Then
            Shape1.Visible = True
        Else
            Shape1.Visible = False
        End If
        Shape2.Visible = False

        ' Field Simbol
        If Check2.Value > 0 Then
            Line8.Visible = True
            Line9.Visible = True
            Line10.Visible = True
        Else
            Line8.Visible = False
            Line9.Visible = False
            Line10.Visible = False
        End If
        Line17.Visible = False
        Line18.Visible = False
        Line19.Visible = False

        ' Tail symbol
        If Check3.Value > 0 Then
            Line3.Visible = True
            Line4.Visible = True
            TailText.Visible = True
'            Label2.Visible = True
        Else
            Line3.Visible = False
            Line4.Visible = False
            TailText.Visible = False
'            Label2.Visible = False
        End If
        Line20.Visible = False
        Line21.Visible = False
        TailText1.Visible = False
'        Label13.Visible = False

        ' Leader symbol
        If Leader.Value > 0 Then
            Line1.Visible = True
            Line6.Visible = True
            Line7.Visible = True
            Line11.Visible = True

            Line12.Visible = False
            Line13.Visible = False
            Line14.Visible = False
            Line15.Visible = False
            Line16.Visible = False
        Else
            Line1.Visible = False
            Line6.Visible = False
            Line7.Visible = False
            Line11.Visible = False

            Line12.Visible = True
            Line13.Visible = True
            Line14.Visible = True
            Line15.Visible = True
            Line16.Visible = True
        End If
        Line22.Visible = False
        Line23.Visible = False
        Line24.Visible = False
        Line25.Visible = False

        Line26.Visible = False
        Line27.Visible = False
        Line28.Visible = False
        Line29.Visible = False
        Line30.Visible = False
    End If

    If Direction.Value = 0 Then
        ' Around symbol
        If Check1.Value > 0 Then
            Shape2.Visible = True
        Else
            Shape2.Visible = False
        End If
        Shape1.Visible = False

        ' Field Simbol
        If Check2.Value > 0 Then
            Line17.Visible = True
            Line18.Visible = True
            Line19.Visible = True
        Else
            Line17.Visible = False
            Line18.Visible = False
            Line19.Visible = False
        End If
        Line8.Visible = False
        Line9.Visible = False
        Line10.Visible = False

        ' Tail symbol
        If Check3.Value > 0 Then
            Line20.Visible = True
            Line21.Visible = True
            TailText1.Visible = True
'            Label13.Visible = True
        Else
            Line20.Visible = False
            Line21.Visible = False
            TailText1.Visible = False
'            Label13.Visible = False
        End If
        Line3.Visible = False
        Line4.Visible = False
        TailText.Visible = False
'        Label2.Visible = False

        ' Leader symbol
        If Leader.Value > 0 Then
            Line22.Visible = True
            Line23.Visible = True
            Line24.Visible = True
            Line25.Visible = True

            Line26.Visible = False
            Line27.Visible = False
            Line28.Visible = False
            Line29.Visible = False
            Line30.Visible = False
        Else
            Line22.Visible = False
            Line23.Visible = False
            Line24.Visible = False
            Line25.Visible = False

            Line26.Visible = True
            Line27.Visible = True
            Line28.Visible = True
            Line29.Visible = True
            Line30.Visible = True
        End If
        Line1.Visible = False
        Line6.Visible = False
        Line7.Visible = False
        Line11.Visible = False

        Line12.Visible = False
        Line13.Visible = False
        Line14.Visible = False
        Line15.Visible = False
        Line16.Visible = False
    End If

Dim Str$
    Str = Chr(186)
    DegTop.Clear
    DegTop.AddItem Str
    DegTop.AddItem " "
    DegBot.Clear
    DegBot.AddItem Str
    DegBot.AddItem " "

End Sub

Private Sub ImageBot_Click()
    Im = 3
Dim frmTop%, frmLeft%
    frmTop = frmWeld.Top
    frmLeft = frmWeld.Left
Dim Im1Top%, Im1Left%, Im1Width%
    Im1Top = frmWeld.ImageBot.Top
    Im1Left = frmWeld.ImageBot.Left
    Im1Width = frmWeld.ImageBot.Width

    frmWeldBotSymbols.Top = frmTop + Im1Top
    frmWeldBotSymbols.Left = frmLeft + Im1Left + 1.2 * Im1Width

    frmWeldBotSymbols.Show 1

End Sub

Private Sub ImageBot1_Click()
    Im = 31
Dim frmTop%, frmLeft%
    frmTop = frmWeld.Top
    frmLeft = frmWeld.Left
Dim Im1Top%, Im1Left%, Im1Width%
    Im1Top = frmWeld.ImageBot1.Top
    Im1Left = frmWeld.ImageBot1.Left
    Im1Width = frmWeld.ImageBot1.Width

    frmWeldBotSymbols.Top = frmTop + Im1Top
    frmWeldBotSymbols.Left = frmLeft + Im1Left + 1.2 * Im1Width

    frmWeldBotSymbols.Show 1

End Sub

Private Sub ImageMid_Click()
    Im = 2
Dim frmTop%, frmLeft%
    frmTop = frmWeld.Top
    frmLeft = frmWeld.Left
Dim Im1Top%, Im1Left%, Im1Width%
    Im1Top = frmWeld.ImageMid.Top
    Im1Left = frmWeld.ImageMid.Left
    Im1Width = frmWeld.ImageMid.Width

    frmWeldMidSymbols.Top = frmTop + Im1Top
    frmWeldMidSymbols.Left = frmLeft + Im1Left + 1.2 * Im1Width

    frmWeldMidSymbols.Show 1

End Sub

Private Sub ImageTop_Click()
    Im = 1
Dim frmTop%, frmLeft%
    frmTop = frmWeld.Top
    frmLeft = frmWeld.Left
Dim Im1Top%, Im1Left%, Im1Width%
    Im1Top = frmWeld.ImageTop.Top
    Im1Left = frmWeld.ImageTop.Left
    Im1Width = frmWeld.ImageTop.Width

    frmWeldTopSymbols.Top = frmTop + Im1Top
    frmWeldTopSymbols.Left = frmLeft + Im1Left + 1.2 * Im1Width

    frmWeldTopSymbols.Show 1

End Sub

Private Sub ImageTop1_Click()
    Im = 11
Dim frmTop%, frmLeft%
    frmTop = frmWeld.Top
    frmLeft = frmWeld.Left
Dim Im1Top%, Im1Left%, Im1Width%
    Im1Top = frmWeld.ImageTop1.Top
    Im1Left = frmWeld.ImageTop1.Left
    Im1Width = frmWeld.ImageTop1.Width

    frmWeldTopSymbols.Top = frmTop + Im1Top
    frmWeldTopSymbols.Left = frmLeft + Im1Left + 1.2 * Im1Width

    frmWeldTopSymbols.Show 1

End Sub

Private Sub Leader_Click()
    If Leader.Value > 0 Then
        If Direction.Value > 0 Then
            Line1.Visible = True
            Line6.Visible = True
            Line7.Visible = True
            Line11.Visible = True

            Line12.Visible = False
            Line13.Visible = False
            Line14.Visible = False
            Line15.Visible = False
            Line16.Visible = False

            Line22.Visible = False
            Line23.Visible = False
            Line24.Visible = False
            Line25.Visible = False

            Line26.Visible = False
            Line27.Visible = False
            Line28.Visible = False
            Line29.Visible = False
            Line30.Visible = False
        Else
            Line1.Visible = False
            Line6.Visible = False
            Line7.Visible = False
            Line11.Visible = False

            Line12.Visible = False
            Line13.Visible = False
            Line14.Visible = False
            Line15.Visible = False
            Line16.Visible = False

            Line22.Visible = True
            Line23.Visible = True
            Line24.Visible = True
            Line25.Visible = True

            Line26.Visible = False
            Line27.Visible = False
            Line28.Visible = False
            Line29.Visible = False
            Line30.Visible = False

        End If
    Else
        If Direction.Value > 0 Then
            Line1.Visible = False
            Line6.Visible = False
            Line7.Visible = False
            Line11.Visible = False

            Line12.Visible = True
            Line13.Visible = True
            Line14.Visible = True
            Line15.Visible = True
            Line16.Visible = True

            Line22.Visible = False
            Line23.Visible = False
            Line24.Visible = False
            Line25.Visible = False

            Line26.Visible = False
            Line27.Visible = False
            Line28.Visible = False
            Line29.Visible = False
            Line30.Visible = False
        Else
            Line1.Visible = False
            Line6.Visible = False
            Line7.Visible = False
            Line11.Visible = False

            Line12.Visible = False
            Line13.Visible = False
            Line14.Visible = False
            Line15.Visible = False
            Line16.Visible = False

            Line22.Visible = False
            Line23.Visible = False
            Line24.Visible = False
            Line25.Visible = False

            Line26.Visible = True
            Line27.Visible = True
            Line28.Visible = True
            Line29.Visible = True
            Line30.Visible = True
        End If
    End If

End Sub

Private Sub TailText_Click()
    TailReference.TextTail.Text = NewTextTail
    TailReference.Show 1
End Sub

Private Sub TailText1_Click()
    TailReference.TextTail.Text = NewTextTail
    TailReference.Show 1
End Sub


Examples - Welding Symbol Regen - WeldMidSymbols.frm

WeldMidSymbols.frm

Welding Symbol Regen Example

VERSION 5.00
Begin VB.Form frmWeldMidSymbols
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Symbol"
   ClientHeight    =   435
   ClientLeft      =   30
   ClientTop       =   270
   ClientWidth     =   1125
   LinkTopic       =   "Form3"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   435
   ScaleWidth      =   1125
   StartUpPosition =   3  'Windows Default
   Begin VB.Image ImSpot
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   720
      Stretch         =   -1  'True
      ToolTipText     =   "None"
      Top             =   0
      Width           =   372
   End
   Begin VB.Image ImSeam
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   360
      Stretch         =   -1  'True
      ToolTipText     =   "Spot/Projection Symbol"
      Top             =   0
      Width           =   372
   End
   Begin VB.Image ImNone
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   0
      Stretch         =   -1  'True
      ToolTipText     =   "Seam Symbol"
      Top             =   0
      Width           =   372
   End
End
Attribute VB_Name = "frmWeldMidSymbols"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
    frmWeldMidSymbols.ImNone.Picture = LoadResPicture(1000, 0)
    frmWeldMidSymbols.ImSeam.Picture = LoadResPicture(3011, 0)
    frmWeldMidSymbols.ImSpot.Picture = LoadResPicture(3013, 0)

End Sub

Private Sub ImNone_Click()
        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        frmWeld.ImageTop1.Enabled = True
        frmWeld.ImageBot1.Enabled = True
        Me.Hide
End Sub

Private Sub ImSeam_Click()
        frmWeld.ImageMid.Picture = LoadResPicture(3011, 0)
        Im2 = "ImSeam"

        frmWeld.ImageTop.Picture = LoadResPicture(1000, 0)
        Im1 = "ImNone"
        frmWeld.ImageTop1.Picture = LoadResPicture(1000, 0)
        Im11 = "ImNone"
        frmWeld.ImageTop1.Enabled = False
        frmWeld.Size_TrTop1.Text = ""
        frmWeld.Size_TrTop1.Enabled = False

        frmWeld.ImageBot.Picture = LoadResPicture(1000, 0)
        Im3 = "ImNone"
        frmWeld.ImageBot1.Picture = LoadResPicture(1000, 0)
        Im31 = "ImNone"
        frmWeld.ImageBot1.Enabled = False
        frmWeld.Size_TrBot1.Text = ""
        frmWeld.Size_TrBot1.Enabled = False

        Me.Hide
End Sub

Private Sub ImSpot_Click()
        frmWeld.ImageMid.Picture = LoadResPicture(3013, 0)
        Im2 = "ImSpot"

        frmWeld.ImageTop.Picture = LoadResPicture(1000, 0)
        Im1 = "ImNone"
        frmWeld.ImageTop1.Picture = LoadResPicture(1000, 0)
        Im11 = "ImNone"
        frmWeld.ImageTop1.Enabled = False
        frmWeld.Size_TrTop1.Text = ""
        frmWeld.Size_TrTop1.Enabled = False

        frmWeld.ImageBot.Picture = LoadResPicture(1000, 0)
        Im3 = "ImNone"
        frmWeld.ImageBot1.Picture = LoadResPicture(1000, 0)
        Im31 = "ImNone"
        frmWeld.ImageBot1.Enabled = False
        frmWeld.Size_TrBot1.Text = ""
        frmWeld.Size_TrBot1.Enabled = False

        Me.Hide
End Sub


Examples - Welding Symbol Regen - WeldTopSymbols.frm

WeldTopSymbols.frm

Welding Symbol Regen Example

VERSION 5.00
Begin VB.Form frmWeldTopSymbols
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Symbols"
   ClientHeight    =   1140
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   2235
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1140
   ScaleWidth      =   2235
   StartUpPosition =   3  'Windows Default
   Begin VB.Image ImNone
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   0
      Stretch         =   -1  'True
      ToolTipText     =   "None"
      Top             =   0
      Width           =   372
   End
   Begin VB.Image ImV_Groove
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1800
      Stretch         =   -1  'True
      ToolTipText     =   "V-Groove Symbol"
      Top             =   360
      Width           =   372
   End
   Begin VB.Image ImU_Groove
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1800
      Stretch         =   -1  'True
      ToolTipText     =   "U-Groove Symbol"
      Top             =   0
      Width           =   372
   End
   Begin VB.Image ImSurfacing
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1440
      Stretch         =   -1  'True
      ToolTipText     =   "Surfacing Symbol"
      Top             =   720
      Width           =   372
   End
   Begin VB.Image ImSquare
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1440
      Stretch         =   -1  'True
      ToolTipText     =   "Square Symbol"
      Top             =   360
      Width           =   372
   End
   Begin VB.Image ImSpot
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1440
      Stretch         =   -1  'True
      ToolTipText     =   "Spot/Projection Symbol"
      Top             =   0
      Width           =   372
   End
   Begin VB.Image ImSlot
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1080
      Stretch         =   -1  'True
      ToolTipText     =   "Plug or slot Symbol"
      Top             =   720
      Width           =   372
   End
   Begin VB.Image ImSeam
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1080
      Stretch         =   -1  'True
      ToolTipText     =   "Seam Symbol"
      Top             =   360
      Width           =   372
   End
   Begin VB.Image ImScarf
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   1080
      Stretch         =   -1  'True
      ToolTipText     =   "Scarf Symbol"
      Top             =   0
      Width           =   372
   End
   Begin VB.Image ImPlug
      BorderStyle     =   1  'Fixed Single
      Height          =   372
      Left            =   720
      Stretch         =   -1  'True
      ToolTipText     =   "Arc spot or arc seam Symbol"
      Top             =   720
      Width           =   372
   End
   Begin VB.Image ImBack
      BorderStyle     =   1  'Fixed Single
      Height          =   360
      Left            =   1800
      Stretch         =   -1  'True
      ToolTipText     =   "Back Symbol"
      Top             =   720
      Width           =   360
   End
   Begin VB.Image ImJ_Groove
      BorderStyle     =   1  'Fixed Single
      Height          =   360
      Left            =   360
      Stretch         =   -1  'True
      ToolTipText     =   "J-Groove Symbol"
      Top             =   720
      Width           =   360
   End
   Begin VB.Image ImFlare_V
      BorderStyle     =   1  'Fixed Single
      Height          =   360
      Left            =   0
      Stretch         =   -1  'True
      ToolTipText     =   "Flare-V Symbol"
      Top             =   720
      Width           =   360
   End
   Begin VB.Image ImFlare_Bevel
      BorderStyle     =   1  'Fixed Single
      Height          =   360
      Left            =   720
      Stretch         =   -1  'True
      ToolTipText     =   "Flare-Bevel Symbol"
      Top             =   360
      Width           =   360
   End
   Begin VB.Image ImFlange_Edge
      BorderStyle     =   1  'Fixed Single
      Height          =   360
      Left            =   360
      Stretch         =   -1  'True
      ToolTipText     =   "Flange_Edge Symbol"
      Top             =   360
      Width           =   360
   End
   Begin VB.Image ImFlange_Corner
      BorderStyle     =   1  'Fixed Single
      Height          =   360
      Left            =   0
      Stretch         =   -1  'True
      ToolTipText     =   "Flange-Corner Symbol"
      Top             =   360
      Width           =   360
   End
   Begin VB.Image ImFillet
      BorderStyle     =   1  'Fixed Single
      Height          =   360
      Left            =   720
      Stretch         =   -1  'True
      ToolTipText     =   "Fillet Symbol"
      Top             =   0
      Width           =   360
   End
   Begin VB.Image ImBevel_Groove
      BorderStyle     =   1  'Fixed Single
      Height          =   360
      Left            =   360
      Stretch         =   -1  'True
      ToolTipText     =   "Bevel-Groove Symbol"
      Top             =   0
      Width           =   360
   End
End
Attribute VB_Name = "frmWeldTopSymbols"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Form_Load()
    frmWeldTopSymbols.ImNone.Picture = LoadResPicture(1000, 0)
    frmWeldTopSymbols.ImBack.Picture = LoadResPicture(1001, 0)
    frmWeldTopSymbols.ImBevel_Groove.Picture = LoadResPicture(1002, 0)
    frmWeldTopSymbols.ImFillet.Picture = LoadResPicture(1003, 0)
    frmWeldTopSymbols.ImFlange_Corner.Picture = LoadResPicture(1004, 0)
    frmWeldTopSymbols.ImFlange_Edge.Picture = LoadResPicture(1005, 0)
    frmWeldTopSymbols.ImFlare_Bevel.Picture = LoadResPicture(1006, 0)
    frmWeldTopSymbols.ImFlare_V.Picture = LoadResPicture(1007, 0)
    frmWeldTopSymbols.ImJ_Groove.Picture = LoadResPicture(1008, 0)
    frmWeldTopSymbols.ImPlug.Picture = LoadResPicture(1009, 0)
    frmWeldTopSymbols.ImScarf.Picture = LoadResPicture(1010, 0)
    frmWeldTopSymbols.ImSeam.Picture = LoadResPicture(1011, 0)
    frmWeldTopSymbols.ImSlot.Picture = LoadResPicture(1012, 0)
    frmWeldTopSymbols.ImSpot.Picture = LoadResPicture(1013, 0)
    frmWeldTopSymbols.ImSquare.Picture = LoadResPicture(1014, 0)
    frmWeldTopSymbols.ImSurfacing.Picture = LoadResPicture(1015, 0)
    frmWeldTopSymbols.ImU_Groove.Picture = LoadResPicture(1016, 0)
    frmWeldTopSymbols.ImV_Groove.Picture = LoadResPicture(1017, 0)

End Sub

Private Sub ImBack_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1001, 0)
            Im1 = "ImBack"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1001, 0)
            Im11 = "ImBack"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

       Me.Hide
End Sub

Private Sub ImBevel_Groove_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1002, 0)
            Im1 = "ImBevel_Groove"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1002, 0)
            Im11 = "ImBevel_Groove"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

         Me.Hide
End Sub

Private Sub ImNone_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1000, 0)
            Im1 = "ImNone"
            frmWeld.ImageTop1.Enabled = False
            frmWeld.ImageTop1.Picture = LoadResPicture(1000, 0)
            Im11 = "ImNone"
            frmWeld.Size_TrTop1.Text = ""
            frmWeld.Size_TrTop1.Enabled = False
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1000, 0)
            Im11 = "ImNone"
            frmWeld.Size_TrTop1.Text = ""
            frmWeld.Size_TrTop1.Enabled = False
        End If

         Me.Hide
End Sub

Private Sub ImFillet_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1003, 0)
            Im1 = "ImFillet"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1003, 0)
            Im11 = "ImFillet"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImFlange_Corner_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1004, 0)
            Im1 = "ImFlange_Corner"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1004, 0)
            Im11 = "ImFlange_Corner"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

         Me.Hide
End Sub

Private Sub ImFlange_Edge_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1005, 0)
            Im1 = "ImFlange_Edge"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1005, 0)
            Im11 = "ImFlange_Edge"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

         Me.Hide
End Sub

Private Sub ImFlare_Bevel_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1006, 0)
            Im1 = "ImFlare_Bevel"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1006, 0)
            Im11 = "ImFlare_Bevel"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

         Me.Hide
End Sub

Private Sub ImFlare_V_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1007, 0)
            Im1 = "ImFlare_V"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1007, 0)
            Im11 = "ImFlare_V"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

         Me.Hide
End Sub

Private Sub ImJ_Groove_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1008, 0)
            Im1 = "ImJ_Groove"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1008, 0)
            Im11 = "ImJ_Groove"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImPlug_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1009, 0)
            Im1 = "ImPlug"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1009, 0)
            Im11 = "ImPlug"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImScarf_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1010, 0)
            Im1 = "ImScarf"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1010, 0)
            Im11 = "ImScarf"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImSeam_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1011, 0)
            Im1 = "ImSeam"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1011, 0)
            Im11 = "ImSeam"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

       Me.Hide
End Sub

Private Sub ImSlot_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1012, 0)
            Im1 = "ImSlot"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1012, 0)
            Im11 = "ImSlot"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImSpot_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1013, 0)
            Im1 = "ImSpot"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1013, 0)
            Im11 = "ImSpot"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImSquare_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1014, 0)
            Im1 = "ImSquare"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1014, 0)
            Im11 = "ImSquare"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImSurfacing_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1015, 0)
            Im1 = "ImSurfacing"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1015, 0)
            Im11 = "ImSurfacing"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImU_Groove_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1016, 0)
            Im1 = "ImU_Groove"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1016, 0)
            Im11 = "ImU_Groove"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub

Private Sub ImV_Groove_Click()
        If Im = 1 Then
            frmWeld.ImageTop.Picture = LoadResPicture(1017, 0)
            Im1 = "ImV_Groove"
            frmWeld.ImageTop1.Enabled = True
        End If
        If Im = 11 Then
            frmWeld.ImageTop1.Picture = LoadResPicture(1017, 0)
            Im11 = "ImV_Groove"
            frmWeld.Size_TrTop1.Enabled = True
        End If

        frmWeld.ImageMid.Picture = LoadResPicture(1000, 0)
        Im2 = "ImNone"

        Me.Hide
End Sub


Examples - Radial Dimension Tie - RadDimTie.cls

RadDimTie.cls

Radial Dimension Tie Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "DimTie"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Implements ITurboCADSmartTieServer

Private Declare Function TCWDrawingActive Lib "TCAPI70.dll" () As Long
Private Declare Function TCWGraphicAt Lib "TCAPI70.dll" (ByVal d As Long, ByVal Index As Long) As Long
Private Declare Function TCWVertexAt Lib "TCAPI70.dll" (ByVal g As Long, ByVal Index As Long) As Long

Private Declare Sub prVertexSetSomeFlags Lib "DBAPI70.dll" (ByVal hVer As Long, ByVal FlagOn As Long, ByVal FlagOff As Long)

Private Declare Function GraphicGetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long) As Long
Private Declare Function GraphicSetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long, ByVal hMat As Long) As Boolean
Private Declare Function MatrixEqual Lib "DBAPI70.dll" (ByVal hM1 As Long, ByVal hM2 As Long) As Boolean

'Useful math constants
Const Pi# = 3.14159265
Const Eps = 0.000001

Public Type VertexTieData
    R As Double
    xc As Double
    yc As Double
    x1 As Double
    y1 As Double
    x2 As Double
    y2 As Double
    iVer As Long
    fiRel As Double
End Type

Private idVTie As String

Private TSets As TieSets
Private TSet  As TieSet
Private Tie   As Tie
Private ActDr   As Drawing
Private tieData As VertexTieData

Private VersSbj As Vertices
Private VersSbd As Vertices

Private Grs   As Graphics
Private GrSbj As Graphic
Private GrSbd As Graphic

Private hDr As Long
Private hGrArc As Long
Private hGrDim As Long
Private hMatArc As Long
Private hMatDim As Long

Private Function Clear()

    Set VersSbj = Nothing
    Set VersSbd = Nothing

    Set GrSbj = Nothing
    Set GrSbd = Nothing
    Set Grs = Nothing
    Set Tie = Nothing
    Set TSet = Nothing
    Set TSets = Nothing
    Set ActDr = Nothing

End Function

Private Function ITurboCADSmartTieServer_AddTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, ByVal lType As Long) As Boolean
'MsgBox ("AddTie")
Dim varData As Variant
    Set ActDr = pIDispDwg
    Set GrSbj = Nothing
    Set GrSbd = Nothing
    Set GrSbj = ActDr.Graphics.GraphicFromID(idSbj)
    Set GrSbd = ActDr.Graphics.GraphicFromID(idSbd)
Dim GrDim As Graphic
Dim GrCon As Graphic
Dim GrConType$

    If GrSbj.Type = "TCW25DimRad" Or GrSbj.Type = "TCW25DimDia" Then
        Set GrDim = GrSbj
        Set GrCon = GrSbd
    Else
        Set GrDim = GrSbd
        Set GrCon = GrSbj
    End If
    GrConType = GrCon.Type
Dim GrDimType$
    GrDimType = GrDim.Type

Dim x0Dim#, y0Dim#, x1Dim#, y1Dim#, x2Dim#, y2Dim#
    With GrDim.Vertices
        x0Dim = .Item(0).X
        y0Dim = .Item(0).Y
        x1Dim = .Item(1).X
        y1Dim = .Item(1).Y
        .Item(1).Editable = False
        x2Dim = .Item(2).X
        y2Dim = .Item(2).Y
    End With
Dim R#, xc#, yc#, iVer As Long
Dim x1#, y1#, fiRel#
    fiRel = 0
    If GrConType = "ARC" Or GrConType = "CIRCLE" Then
        With GrCon.Vertices
            xc = .Item(0).X
            yc = .Item(0).Y
            x1 = .Item(1).X
            y1 = .Item(1).Y
        End With
        iVer = 0
    End If

    If GrConType = "TCW50Polyline" Then
Dim nV As Long, i As Long, xi#, yi#
        With GrCon.Vertices
            nV = .Count
            For i = 0 To nV - 1
                If .Item(i).Bulge = True Then
                    xi = .Item(i).X
                    yi = .Item(i).Y
                    If Abs(xi - x0Dim) < Eps And Abs(yi - y0Dim) < Eps Then
                        xc = xi
                        yc = yi
                        x1 = .Item(i + 1).X
                        y1 = .Item(i + 1).Y
                        iVer = i
                        Exit For
                    End If
                End If
            Next i
        End With
    End If

    R = Sqr((x1 - xc) * (x1 - xc) + (y1 - yc) * (y1 - yc))

    Set TSets = ActDr.TieSets
    Set TSet = TSets.TieSet(idSbj, idSbd)
        tieData.R = R
        tieData.xc = xc
        tieData.yc = yc
        tieData.x1 = x1Dim
        tieData.y1 = y1Dim
        tieData.x2 = x2Dim
        tieData.y2 = y2Dim
        tieData.iVer = iVer
        tieData.fiRel = fiRel
        varData = tieData
        TSet.AddTie idVTie, 1, varData

    Set TSet = TSets.TieSet(idSbd, idSbj)
        tieData.R = R
        tieData.xc = xc
        tieData.yc = yc
        tieData.x1 = x1Dim
        tieData.y1 = y1Dim
        tieData.x2 = x2Dim
        tieData.y2 = y2Dim
        tieData.iVer = iVer
        tieData.fiRel = fiRel
        varData = tieData
        TSet.AddTie idVTie, 1, varData

        Set GrDim = Nothing
        Set GrCon = Nothing
'MsgBox ("End Add Tie")
    ITurboCADSmartTieServer_AddTie = True
    Clear

End Function

Private Function ITurboCADSmartTieServer_CopyTie(ByVal pIDispDwg As Object, ByVal idSbjSrc As Long, ByVal idSbdSrc As Long, ByVal idSbjTrg As Long, ByVal idSbdTrg As Long) As Boolean

    Set ActDr = pIDispDwg
    Set Grs = ActDr.Graphics
    Set GrSbj = Grs.GraphicFromID(idSbjTrg)
    Set GrSbd = Grs.GraphicFromID(idSbdTrg)

    Set TSets = ActDr.TieSets
    Set TSet = TSets.TieSet(idSbjSrc, idSbdSrc)
    Set Tie = TSet(0)
    tieData = Tie.Data

'    TSets.Add idVTie, GrSbj, GrSbd, tieData.idVrtSbj, 0, TSet

    Set Tie = TSet(0)
    Tie.Data = tieData

    Clear

    ITurboCADSmartTieServer_CopyTie = True
End Function

Private Function ITurboCADSmartTieServer_DeleteTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, ByVal pIDsipGr As Object) As Boolean
    ITurboCADSmartTieServer_DeleteTie = True
End Function

Private Property Get ITurboCADSmartTieServer_Description() As String
    ITurboCADSmartTieServer_Description = "RadDimevsion_Tie"
End Property

Private Function ITurboCADSmartTieServer_GetIDs(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Variant
' It is not need to do something here because this method doesn't use Graphic's DataBase ID
End Function

Private Function ITurboCADSmartTieServer_GetTypesInfo(Names As Variant, Types As Variant) As Long
    ITurboCADSmartTieServer_GetTypesInfo = 0
End Function

Private Function ITurboCADSmartTieServer_Initialize(ByVal ThisTieMethod As Object) As Boolean
    Dim gxTMethod As TieMethod
    Set gxTMethod = ThisTieMethod
    idVTie = gxTMethod.Name
    ITurboCADSmartTieServer_Initialize = True
End Function

Private Sub ITurboCADSmartTieServer_SetIDs(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, pvarIDs As Variant)
' It is not need to do something here because this method doesn't use Graphic's DataBase ID
End Sub

Private Function ITurboCADSmartTieServer_TieCanNODEED(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Boolean
    ITurboCADSmartTieServer_TieCanNODEED = True
End Function

Private Function ITurboCADSmartTieServer_UpdateTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Integer

    Set ActDr = pIDispDwg

    Set TSets = ActDr.TieSets
    Set TSet = TSets.TieSet(idSbj, idSbd)

    UpdateTie TSet, TSets, idSbj, idSbd

    ITurboCADSmartTieServer_UpdateTie = 0
    Clear

End Function

Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function

' Define the direction of Arc rotation
' return ArcRotation = 1 if CounterClockwise
' return ArcRotation = -1 if Clockwise

Private Function ArcRotation(xB As Double, yB As Double, xDir As Double, yDir As Double, xc As Double, yc As Double, R As Double) As Integer
Dim sina#, cosa# ', Alp0#, Alp1#
    sina = (yB - yc) / R
    cosa = (xB - xc) / R
Dim xLoc#, yLoc#
    xLoc = (yDir - yc) * sina + (xDir - xc) * cosa
    yLoc = (yDir - yc) * cosa - (xDir - xc) * sina
    If yLoc > 0 Then
        ArcRotation = -1
    Else
        ArcRotation = 1
    End If
End Function

'###################################################################
'###################################################################
'###################################################################

Private Function UpdateTie(ByRef TSet As TieSet, ByRef TSets As TieSets, ByVal idSbj As Long, ByVal idSbd As Long)
'MsgBox ("Update Tie")
    Dim varData As Variant
    Set ActDr = TSets.Drawing
    Set GrSbj = Nothing
    Set GrSbd = Nothing
    Set GrSbj = ActDr.Graphics.GraphicFromID(idSbj)
    Set GrSbd = ActDr.Graphics.GraphicFromID(idSbd)

    Set Tie = TSet(0)
    varData = Tie.Data
    tieData = varData(0)
Dim ROld#, xcOld#, ycOld#, x1Old#, y1Old#, iVer As Long, fiRel#
    ROld = tieData.R
    xcOld = tieData.xc
    ycOld = tieData.yc
    x1Old = tieData.x1
    y1Old = tieData.y1
    iVer = tieData.iVer
    fiRel = tieData.fiRel
'MsgBox ("ROld=" & CStr(ROld) & " xcOld=" & CStr(xcOld) & " ycOld=" & CStr(ycOld) & "  x1Old=" & CStr(x1Old) & " y1Old=" & CStr(y1Old))

Dim GrDim As Graphic
Dim GrCon As Graphic
Dim GrConType$
Dim EditedGr$

    If GrSbj.Type = "TCW25DimRad" Or GrSbj.Type = "TCW25DimDia" Then
        EditedGr = "Dim"
        Set GrDim = GrSbj
        Set GrCon = GrSbd
    Else
        EditedGr = "Base"
        Set GrDim = GrSbd
        Set GrCon = GrSbj
    End If

    GrConType = GrCon.Type
Dim GrDimType$
    GrDimType = GrDim.Type
'MsgBox (GrConType & "   " & GrDimType)
'Dim xcNew#, ycNew#, RNew#, x1New#, y1New#
Dim xcArc#, ycArc#, x1Arc#, y1Arc#, RArc#
Dim dx#, dy#
Dim x0Dim#, y0Dim#, x1Dim#, y1Dim#, x2Dim#, y2Dim#

' ##########################################################################
' ##########################################################################
' ##########################################################################
' ##########################################################################
    If EditedGr = "Base" Then
        With GrDim.Vertices
            x0Dim = .Item(0).X
            y0Dim = .Item(0).Y
            x1Dim = .Item(1).X
            y1Dim = .Item(1).Y
            x2Dim = .Item(2).X
            y2Dim = .Item(2).Y
        End With
Dim R12Dim#
        R12Dim = Sqr((x2Dim - x0Dim) * (x2Dim - x0Dim) + (y2Dim - y0Dim) * (y2Dim - y0Dim))
        If GrConType = "ARC" Or GrConType = "CIRCLE" Then

            With GrCon.Vertices
                xcArc = .Item(0).X
                ycArc = .Item(0).Y
                x1Arc = .Item(1).X
                y1Arc = .Item(1).Y
            End With
        Else
            With GrCon.Vertices
                xcArc = .Item(iVer).X
                ycArc = .Item(iVer).Y
                x1Arc = .Item(iVer + 1).X
                y1Arc = .Item(iVer + 1).Y
            End With
        End If
        RArc = Sqr((x1Arc - xcArc) * (x1Arc - xcArc) + (y1Arc - ycArc) * (y1Arc - ycArc))
        x0Dim = xcArc
        y0Dim = ycArc
        x1Dim = x0Dim + (x1Old - xcOld) * RArc / ROld
        y1Dim = y0Dim + (y1Old - ycOld) * RArc / ROld
        x2Dim = x1Dim + (x1Dim - x0Dim) / RArc * (R12Dim - ROld)
        y2Dim = y1Dim + (y1Dim - y0Dim) / RArc * (R12Dim - ROld)

'MsgBox ("RNew=" & CStr(RNew) & " x0Dim=" & CStr(x0Dim) & " y0Dim=" & CStr(y0Dim) & "  x1Dim=" & CStr(x1Dim) & " y1Dim=" & CStr(y1Dim))
        With GrDim.Vertices
            .Item(0).X = x0Dim
            .Item(0).Y = y0Dim
            .Item(2).X = x2Dim
            .Item(2).Y = y2Dim
            .Item(1).X = x1Dim
            .Item(1).Y = y1Dim
        End With
        GrDim.Update
        GrDim.Draw
        GrDim.Vertices(1).Editable = False
        ' Write New Data into TSet Structures
        Set TSets = ActDr.TieSets
        Set TSet = TSets.TieSet(idSbj, idSbd)
            tieData.R = RArc
            tieData.xc = x0Dim
            tieData.yc = y0Dim
            tieData.x1 = x1Dim
            tieData.y1 = y1Dim
            tieData.x2 = x2Dim
            tieData.y2 = y2Dim
            tieData.iVer = iVer
            tieData.fiRel = fiRel
            varData = tieData
            TSet.AddTie idVTie, 1, varData

        Set TSet = TSets.TieSet(idSbd, idSbj)
            tieData.R = RArc
            tieData.xc = x0Dim
            tieData.yc = y0Dim
            tieData.x1 = x1Dim
            tieData.y1 = y1Dim
            tieData.x2 = x2Dim
            tieData.y2 = y2Dim
            tieData.iVer = iVer
            tieData.fiRel = fiRel
            varData = tieData
            TSet.AddTie idVTie, 1, varData
    End If
' ##########################################################################
' ##########################################################################
' ##########################################################################
' ##########################################################################

'Dim xcArc#, ycArc#, x1Arc#, y1Arc#, RArc#

    If EditedGr = "Dim" Then
        With GrDim.Vertices
            x0Dim = .Item(0).X
            y0Dim = .Item(0).Y
            x1Dim = .Item(1).X
            y1Dim = .Item(1).Y
            x2Dim = .Item(2).X
            y2Dim = .Item(2).Y
        End With
        If GrConType = "ARC" Or GrConType = "CIRCLE" Then
            With GrCon.Vertices
                xcArc = .Item(0).X
                ycArc = .Item(0).Y
                x1Arc = .Item(1).X
                y1Arc = .Item(1).Y
            End With
        Else
            With GrCon.Vertices
                xcArc = .Item(iVer).X
                ycArc = .Item(iVer).Y
                x1Arc = .Item(iVer + 1).X
                y1Arc = .Item(iVer + 1).Y
            End With
        End If
        RArc = Sqr((x1Arc - xcArc) * (x1Arc - xcArc) + (y1Arc - ycArc) * (y1Arc - ycArc))

        With GrDim.Vertices
            x0Dim = .Item(0).X
            y0Dim = .Item(0).Y
            x1Dim = .Item(1).X
            y1Dim = .Item(1).Y
            x2Dim = .Item(2).X
            y2Dim = .Item(2).Y
            .Item(0).X = xcArc
            .Item(0).Y = ycArc
        End With

Dim R01Dim#, R02Dim#
        R01Dim = Sqr((x1Dim - x0Dim) * (x1Dim - x0Dim) + (y1Dim - y0Dim) * (y1Dim - y0Dim))
        R02Dim = Sqr((x2Dim - xcArc) * (x2Dim - xcArc) + (y2Dim - ycArc) * (y2Dim - ycArc))

Dim StrInfo$, Str#
Dim StrLen%
Dim RInfo#
        If GrConType = "ARC" Or GrConType = "CIRCLE" Then
            StrInfo = GrDim.Properties("Info")
            StrLen = VBA.Len(StrInfo)
            Str = VBA.Right(StrInfo, StrLen - 1)
            RInfo = CDbl(Str)
            If Abs(RInfo - RArc) > GrDim.Properties("$DIMRND") Then
Dim x2Arc#, y2Arc#, x3Arc#, y3Arc#
                With GrCon.Vertices
                    xcArc = .Item(0).X
                    ycArc = .Item(0).Y
                    x1Arc = .Item(1).X
                    y1Arc = .Item(1).Y
                    x2Arc = .Item(2).X
                    y2Arc = .Item(2).Y
                    x3Arc = .Item(3).X
                    y3Arc = .Item(3).Y
                    GrCon.Visible = False
                    GrCon.Draw

                    .Item(1).X = xcArc + (x1Arc - xcArc) * RInfo / RArc
                    .Item(1).Y = ycArc + (y1Arc - ycArc) * RInfo / RArc
                    .Item(2).X = xcArc + (x2Arc - xcArc) * RInfo / RArc
                    .Item(2).Y = ycArc + (y2Arc - ycArc) * RInfo / RArc
                    .Item(3).X = xcArc + (x3Arc - xcArc) * RInfo / RArc
                    .Item(3).Y = ycArc + (y3Arc - ycArc) * RInfo / RArc
                End With
'                GrCon.Update
                GrCon.Visible = True
                GrCon.Draw

                If Abs(R01Dim - RInfo) > GrDim.Properties("$DIMRND") Then
                    With GrDim.Vertices
                        x1Dim = xcArc + (x1Dim - x0Dim) * RInfo / RArc
                        y1Dim = ycArc + (y1Dim - y0Dim) * RInfo / RArc
                        x2Dim = xcArc + (x2Dim - x0Dim) * RInfo / RArc
                        y2Dim = ycArc + (y2Dim - y0Dim) * RInfo / RArc
                        .Item(1).X = x1Dim
                        .Item(1).Y = y1Dim
                        .Item(2).X = x2Dim
                        .Item(2).X = x2Dim
                    End With
                    GrDim.Update
                    GrDim.Draw
                End If
            End If
            RArc = RInfo
        End If
        If GrConType = "TCW50Polyline" Then
            StrInfo = GrDim.Properties("Info")
            StrLen = VBA.Len(StrInfo)
            Str = VBA.Right(StrInfo, StrLen - 1)
            RInfo = CDbl(Str)
            If Abs(RInfo - RArc) > Eps Then

                With GrCon.Vertices
                    xcArc = .Item(iVer).X
                    ycArc = .Item(iVer).Y
                    x1Arc = .Item(iVer - 1).X
                    y1Arc = .Item(iVer - 1).Y
                    x2Arc = .Item(iVer + 1).X
                    y2Arc = .Item(iVer + 1).Y
                    x3Arc = .Item(iVer + 2).X
                    y3Arc = .Item(iVer + 2).Y
                    GrCon.Visible = False
                    GrCon.Draw

                    .Item(iVer - 1).X = xcArc + (x1Arc - xcArc) * RInfo / RArc
                    .Item(iVer - 1).Y = ycArc + (y1Arc - ycArc) * RInfo / RArc
                    .Item(iVer + 1).X = xcArc + (x2Arc - xcArc) * RInfo / RArc
                    .Item(iVer + 1).Y = ycArc + (y2Arc - ycArc) * RInfo / RArc
                    .Item(iVer + 2).X = xcArc + (x3Arc - xcArc) * RInfo / RArc
                    .Item(iVer + 2).Y = ycArc + (y3Arc - ycArc) * RInfo / RArc
                End With
'                GrCon.Update
                GrCon.Visible = True
                GrCon.Update
                GrCon.Draw
                If Abs(R01Dim - RInfo) > Eps Then
                    With GrDim.Vertices
                        x1Dim = xcArc + (x1Dim - x0Dim) * RInfo / RArc
                        y1Dim = ycArc + (y1Dim - y0Dim) * RInfo / RArc
                        x2Dim = xcArc + (x2Dim - x0Dim) * RInfo / RArc
                        y2Dim = ycArc + (y2Dim - y0Dim) * RInfo / RArc
                        .Item(1).X = x1Dim
                        .Item(1).Y = y1Dim
                        .Item(2).X = x2Dim
                        .Item(2).X = x2Dim
                    End With
                    GrDim.Update
                    GrDim.Draw
                End If
            End If
            RArc = RInfo
        End If

        If Abs(xcArc - x0Dim) < Eps And Abs(ycArc - y0Dim) < Eps Then
        Else
            GrDim.Update
            GrDim.Draw
        End If
        GrDim.Vertices(1).Editable = False
        ' Write New Data into TSet Structures
        Set TSets = ActDr.TieSets
        Set TSet = TSets.TieSet(idSbj, idSbd)
            tieData.R = RArc
            tieData.xc = xcArc
            tieData.yc = ycArc
            tieData.x1 = x1Dim
            tieData.y1 = y1Dim
            tieData.x2 = x2Dim
            tieData.y2 = y2Dim
            tieData.iVer = iVer
            tieData.fiRel = fiRel
            varData = tieData
            TSet.AddTie idVTie, 1, varData

        Set TSet = TSets.TieSet(idSbd, idSbj)
            tieData.R = RArc
            tieData.xc = xcArc
            tieData.yc = ycArc
            tieData.x1 = x1Dim
            tieData.y1 = y1Dim
            tieData.x2 = x2Dim
            tieData.y2 = y2Dim
            tieData.iVer = iVer
            tieData.fiRel = fiRel
            varData = tieData
            TSet.AddTie idVTie, 1, varData

    End If
' ##########################################################################
' ##########################################################################
' ##########################################################################
' ##########################################################################

End Function


Examples - Radial Dimension Tie - modRadDimTie.bas

modRadDimTie.bas

Radial Dimension Tie Example

Attribute VB_Name = "modRadDimTie"
Option Explicit

Sub RadDiaCon()
Dim ActDr As Drawing
Dim Grs As Graphics
Dim Vi As View
Dim GrDim As Graphic

    Set ActDr = ActiveDrawing
    Set Grs = ActDr.Graphics
    Set Vi = ActDr.ActiveView

Dim xCl#, yCl#
    Vi.GetMouseClick xCl, yCl
Dim PRes As PickResult
    Set PRes = Vi.PickPoint(xCl, yCl)
Dim PicCount As Long, i As Long
    PicCount = PRes.Count
    If PicCount = 0 Then
        Exit Sub
    End If
Dim GrType$
Dim GrDimExist As Boolean
    GrDimExist = False
    For i = 0 To PicCount - 1
        Set GrDim = PRes(i).Graphic
        GrType = GrDim.Type
        If GrType = "TCW25DimRad" Or GrType = "TCW25DimDia" Then
            GrDimExist = True
            Exit For
        End If
    Next i

    If GrDimExist = False Then Exit Sub

Dim x1Dim#, y1Dim#
    With GrDim.Vertices
        x1Dim = .Item(1).X
        y1Dim = .Item(1).Y
    End With
Dim x1DimV#, y1DimV#
    Vi.WorldToView x1Dim, y1Dim, 0, x1DimV, y1DimV, 0
    Set PRes = Vi.PickPoint(x1DimV, y1DimV)
    PicCount = PRes.Count
    If PicCount = 0 Then Exit Sub

Dim GrCon As Graphic
Dim GrConExist As Boolean
    GrConExist = False
    For i = 0 To PicCount - 1
        Set GrCon = PRes(i).Graphic
        GrType = GrCon.Type
        If GrType = "ARC" Or GrType = "CIRCLE" Or GrType = "TCW50Polyline" Then
            GrConExist = True
            Exit For
        End If
    Next i

    If GrConExist = False Then Exit Sub
Dim TSets As TieSets
    Set TSets = ActDr.TieSets
    TSets.Add "RadDia.DimTie", GrCon, GrDim, 0, 0

End Sub


Examples - Radial Dimension Tie - radimtie.bas

radimtie.bas

Radial Dimension Tie Example

Attribute VB_Name = "Module1"
Sub RadDiaCon()
Dim ActDr As Drawing
Dim Grs As Graphics
Dim Vi As View
Dim GrDim As Graphic

    Set ActDr = ActiveDrawing
    Set Grs = ActDr.Graphics
    Set Vi = ActDr.ActiveView

Dim xCl#, yCl#
    Vi.GetMouseClick xCl, yCl
Dim PRes As PickResult
    Set PRes = Vi.PickPoint(xCl, yCl)
Dim PicCount As Long, i As Long
    PicCount = PRes.Count
    If PicCount = 0 Then
        Exit Sub
    End If
Dim GrType$
Dim GrDimExist As Boolean
    GrDimExist = False
    For i = 0 To PicCount - 1
        Set GrDim = PRes(i).Graphic
        GrType = GrDim.Type
        If GrType = "TCW25DimRad" Or GrType = "TCW25DimDia" Then
            GrDimExist = True
            Exit For
        End If
    Next i

    If GrDimExist = False Then Exit Sub

Dim x1Dim#, y1Dim#
    With GrDim.Vertices
        x1Dim = .Item(1).X
        y1Dim = .Item(1).Y
    End With
Dim x1DimV#, y1DimV#
    Vi.WorldToView x1Dim, y1Dim, 0, x1DimV, y1DimV, 0
    Set PRes = Vi.PickPoint(x1DimV, y1DimV)
    PicCount = PRes.Count
    If PicCount = 0 Then Exit Sub

Dim GrCon As Graphic
Dim GrConExist As Boolean
    GrConExist = False
    For i = 0 To PicCount - 1
        Set GrCon = PRes(i).Graphic
        GrType = GrCon.Type
        If GrType = "ARC" Or GrType = "CIRCLE" Or GrType = "TCW50Polyline" Then
            GrConExist = True
            Exit For
        End If
    Next i

    If GrConExist = False Then Exit Sub
Dim TSets As TieSets
    Set TSets = ActDr.TieSets
    TSets.Add "RadDia.DimTie", GrCon, GrDim, 0, 0

End Sub


Examples - Vertex Tie - VertexTie.cls

VertexTie.cls

Vertex Tie Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsVertexTie"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Implements ITurboCADSmartTieServer

Public Type VertexTieData
    idVrtSbj As Long
    idVrtSbd As Long
End Type

Private idVTie As String

Private gxTSets As TieSets
Private gxTSet  As TieSet
Private gxTie   As Tie
Private gxDwg   As Drawing
Private tieData As VertexTieData

Private gxVrtsSbj As Vertices
Private gxVrtsSbd As Vertices

Private gxGrs   As Graphics
Private gxGrSbj As Graphic
Private gxGrSbd As Graphic

Private Function Clear()

    Set gxVrtsSbj = Nothing
    Set gxVrtsSbd = Nothing

    Set gxGrSbj = Nothing
    Set gxGrSbd = Nothing
    Set gxGrs = Nothing
    Set gxTie = Nothing
    Set gxTSet = Nothing
    Set gxTSets = Nothing
    Set gxDwg = Nothing

End Function

Private Function ITurboCADSmartTieServer_AddTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, ByVal lType As Long) As Boolean

    Dim varData As Variant
    Set gxDwg = pIDispDwg

    Set gxTSets = gxDwg.TieSets
    Set gxTSet = gxTSets.TieSet(idSbj, idSbd)
    If (gxTSet.Count = 0) Then
        tieData.idVrtSbj = lType
        tieData.idVrtSbd = -1
        varData = tieData
        gxTSet.AddTie idVTie, 1, varData
    Else
        Set gxTie = gxTSet(0)
        varData = gxTie.Data
        tieData = varData(0)
        tieData.idVrtSbd = lType
        varData = tieData
        gxTie.Data = tieData
    End If

    Set gxTSet = gxTSets.TieSet(idSbd, idSbj)
    If (gxTSet.Count = 0) Then
        tieData.idVrtSbj = -1
        tieData.idVrtSbd = lType
        varData = tieData
        gxTSet.AddTie idVTie, 1, varData
    Else
        Set gxTie = gxTSet(0)
        varData = gxTie.Data
        tieData = varData(0)
        tieData.idVrtSbj = lType
        varData = tieData
        gxTie.Data = tieData
    End If

    UpdateTie gxTSet
    ITurboCADSmartTieServer_AddTie = True
    Clear

End Function

Private Function ITurboCADSmartTieServer_CopyTie(ByVal pIDispDwg As Object, ByVal idSbjSrc As Long, ByVal idSbdSrc As Long, ByVal idSbjTrg As Long, ByVal idSbdTrg As Long) As Boolean

    Set gxDwg = pIDispDwg
    Set gxGrs = gxDwg.Graphics
    Set gxGrSbj = gxGrs.GraphicFromID(idSbjTrg)
    Set gxGrSbd = gxGrs.GraphicFromID(idSbdTrg)

    Set gxTSets = gxDwg.TieSets
    Set gxTSet = gxTSets.TieSet(idSbjSrc, idSbdSrc)
    Set gxTie = gxTSet(0)
    tieData = gxTie.Data

    gxTSets.Add idVTie, gxGrSbj, gxGrSbd, tieData.idVrtSbj, 0, gxTSet

    Set gxTie = gxTSet(0)
    gxTie.Data = tieData

    Clear

    ITurboCADSmartTieServer_CopyTie = True
End Function

Private Function ITurboCADSmartTieServer_DeleteTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, ByVal pIDsipGr As Object) As Boolean
    ITurboCADSmartTieServer_DeleteTie = True
End Function

Private Property Get ITurboCADSmartTieServer_Description() As String
    ITurboCADSmartTieServer_Description = "Vertex tie"
End Property

Private Function ITurboCADSmartTieServer_GetIDs(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Variant
' It is not need to do something here because this method doesn't use Graphic's DataBase ID
End Function

Private Function ITurboCADSmartTieServer_GetTypesInfo(Names As Variant, Types As Variant) As Long
    ITurboCADSmartTieServer_GetTypesInfo = 0
End Function

Private Function ITurboCADSmartTieServer_Initialize(ByVal ThisTieMethod As Object) As Boolean
    Dim gxTMethod As TieMethod
    Set gxTMethod = ThisTieMethod
    idVTie = gxTMethod.Name
    ITurboCADSmartTieServer_Initialize = True
End Function

Private Function UpdateTie(ByRef gxTSet As TieSet)

    Dim gxVrtSbj As Vertex
    Dim gxVrtSbd As Vertex
    Dim varData As Variant
    Dim gxGrSbdNew As Graphic

    Dim gxDwg As Drawing
    Dim hDwg As Long
    Dim hGrSbd As Long
    Dim idSbd As Long

    Set gxTie = gxTSet(0)

    varData = gxTie.Data
    tieData = varData(0)

    If (tieData.idVrtSbd <> -1 And tieData.idVrtSbj <> -1) Then

            Set gxGrSbj = gxTSet.Subject
            Set gxGrSbd = gxTSet.Subordinate

            Set gxVrtsSbj = gxGrSbj.Vertices
            Set gxVrtsSbd = gxGrSbd.Vertices

            gxVrtsSbj.UseWorldCS = True
            gxVrtsSbd.UseWorldCS = True

            Set gxVrtSbj = gxVrtsSbj(tieData.idVrtSbj)
            Set gxVrtSbd = gxVrtsSbd(tieData.idVrtSbd)

            gxGrSbd.Deleted = True
            gxGrSbd.Draw
            gxGrSbd.Deleted = False

            gxVrtSbd.X = gxVrtSbj.X
            gxVrtSbd.Y = gxVrtSbj.Y
            gxVrtSbd.Z = gxVrtSbj.Z

            gxGrSbd.Draw

            Set gxVrtSbd = Nothing
            Set gxVrtSbj = Nothing
            Set gxGrSbj = Nothing
            Set gxGrSbd = Nothing

    End If

End Function

Private Sub ITurboCADSmartTieServer_SetIDs(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, pvarIDs As Variant)
' It is not need to do something here because this method doesn't use Graphic's DataBase ID
End Sub

Private Function ITurboCADSmartTieServer_TieCanNODEED(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Boolean
    ITurboCADSmartTieServer_TieCanNODEED = True
End Function

Private Function ITurboCADSmartTieServer_UpdateTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Integer

    Set gxDwg = pIDispDwg

    Set gxTSets = gxDwg.TieSets

    Set gxTSet = gxTSets.TieSet(idSbj, idSbd)

    UpdateTie gxTSet

    ITurboCADSmartTieServer_UpdateTie = 0
    Clear

End Function


Examples - Vertex Tie - clsTCEventHandler.cls

clsTCEventHandler.cls

Vertex Tie Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsTCEventHandler"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Public Enum stateEnum
     enStart = 0
     enSelFirst = 1
     enSelSecond = 2
     enFinish = 3
End Enum

Public state As stateEnum

Private xdbToolEvents As IToolEvents
Private gxGrSbj As Graphic
Private gxGrSbd As Graphic

Public Function MouseDown(WhichDrawing As Object, WhichView As Object, WhichWindow As Object, Button As ImsiMouseButton, Shift As Long, X As Long, Y As Long, Cancel As IMSI_BOOL)

    Dim gxView As View
    Dim xView As Double
    Dim yView As Double
    Dim XScr As Double
    Dim YScr As Double
    Dim gxPResult As PickResult

    Dim gxGr As Graphic
    Dim gxVrt As Vertex

    Set gxView = WhichView
    If (Button = imsiLeftButton) Then
        XScr = X
        YScr = Y
        WhichView.ScreenToView XScr, YScr, xView, yView
        Set gxPResult = WhichView.PickPoint(xView, yView, , , False, False, True, False, False)
        If (gxPResult.Count > 0) Then
            Set gxGr = gxPResult(0).Graphic
            ProcesNextPoint WhichDrawing, WhichView, gxGr
        Else
            Beep
        End If

        Cancel = True
    Else
        Cancel = False
    End If

End Function

Public Function RunTool(WhichTool As Tool)
    DoLMCommand 0
End Function

Public Function DrawingDeactivate(WhichDrawing As IDrawing)
    DoLMCommand 0
End Function

Public Function ProcesNextPoint(Optional gxDwg As IDrawing, Optional gxView As View, Optional gxGr As Graphic)
    Dim gxTSets As TieSets

    Select Case state
    Case enBegin
        xdbToolEvents.ToolChangePrompt Me, "Select subject graphic for Vertex Tie", False
        xdbToolEvents.ToolChangeCommands Me, 1, "Finish", "Finish AddVertexTie macro", True, False, True
        state = enSelFirst
    Case enSelFirst
        xdbToolEvents.ToolChangePrompt Me, "Select subordinate graphic for Vertex Tie", False
        Set gxGrSbj = gxGr
        state = enSelSecond
    Case enSelSecond
        xdbToolEvents.ToolChangePrompt Me, "Select subject graphic for Vertex Tie", False
        Set gxGrSbd = gxGr
        Set gxTSets = gxDwg.TieSets
        gxTSets.Add "VertexTie.clsVertexTie", gxGrSbj, gxGrSbd, 0, 0
        gxTSets.Add "VertexTie.clsVertexTie", gxGrSbj, gxGrSbd, 1, 0

        state = enSelFirst
        Set gxGrSbj = Nothing
        Set gxGrSbd = Nothing
        gxView.Refresh
    End Select

End Function

Public Function DoLMCommand(idLMCmd As Long)
    xdbToolEvents.ToolChangePrompt Me, "", True
    xdbToolEvents.ToolChangeCommands Me, 0, , , , , False
    Application.DisconnectEvents idConnection
    state = enFinish
    Set gxGrSbj = Nothing
    Set gxGrSbd = Nothing
    tcEventsHandler = Nothing
End Function

Private Sub Class_Initialize()
    Set xdbToolEvents = Application
    state = enStart
End Sub


Examples - Vertex Tie - modAddVertexTie.bas

modAddVertexTie.bas

Vertex Tie Example

Attribute VB_Name = "modAddVertexTie"
Public tcEventsHandler As clsTCEventHandler
Public idConnection As Long

Public Sub AddVertexTie()

    Selection.Unselect
    Set tcEventsHandler = New clsTCEventHandler
    idConnection = Application.ConnectEvents(tcEventsHandler, imsiEventMouseDown + imsiEventRunTool + imsiEventDrawingDeactivate)
    tcEventsHandler.ProcesNextPoint

End Sub


Examples - 2D Boolean Tool - Bool2D.cls

Bool2D.cls

2D Boolean Tool Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "PlaneFigure"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

Option Explicit

'Number of tools in this server
Const NUM_TOOLS = 3
Private ContCom As ContGeo
Private Cont0 As ContGeo ' structures of data for internal contours for first selected graphic
Private Cont1 As ContGeo ' structures of data for internal contours for second selected graphic
Private Cont0Int() As ContGeo ' array of structures of data for internal contours for first selected graphic
Private Cont1Int() As ContGeo ' array of structures of data for internal contours for second selected graphic
Private n0Int As Long ' count of internal contours for first selected graphic
Private n1Int As Long ' count of internal contours for second selected graphic
Private Dist() As DDD
Private BetaMin() As TTT
Private GrFirst As Graphic
Private GrSecond As Graphic
Public nClick%
Private GrFirstPenColor As Long
Private GrFirstBrushColor As Long
Private GrFirstPenStyle As Variant

'Const EventMask = 1024 + 2048 + 4096 + 268435456 + 536870912
'Const EventMask = 1024 + 4096 + 268435456 + 536870912
Const EventMask = 1 + 2 + 4 + 8 + 16 + 32 + 64 + 1024 + 2048 + 4096 + 8192 + 262144 + 268435456 + 536870912
Private iConnectId As Long
Private iActTool As Long
Private theToolEvents As IToolEvents
'Toggle this to test loading buttons from .Bmp/.Res
Const boolLoadFromBmp As Boolean = False
Const boolDebug As Boolean = False

Private Declare Function TCWUndo Lib "TCAPI70.dll" (ByVal i As Long) As Long
Private Declare Function TCWUndoRecordEnd Lib "TCAPI70.dll" (ByVal d As Long) As Long
Private Declare Function TCWUndoRecordStart Lib "TCAPI70.dll" (ByVal d As Long, ByRef title As String) As Long
Private Declare Function TCWUndoRecordAddGraphic Lib "TCAPI70.dll" (ByVal d As Long, ByVal g As Long) As Long
Private Declare Function TCWDrawingActive Lib "TCAPI70.dll" () As Long
Private Declare Function TCWGraphicAt Lib "TCAPI70.dll" (ByVal d As Long, ByVal Index As Long) As Long
Private Declare Function TCWGraphicDispose Lib "TCAPI70.dll" (ByVal g As Long) As Long
Private hDrawing As Long
Private hGraphic As Long

Private Declare Function GraphicGetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long) As Long
Private Declare Function GraphicSetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long, ByVal hMat As Long) As Boolean
Private Declare Function MatrixEqual Lib "DBAPI70.dll" (ByVal hM1 As Long, ByVal hM2 As Long) As Boolean
Private DifferentWorkPlanes As Boolean

Private ResID(100) As Long
Private ResNum As Long

'##########################################################################
'##########################################################################
'##########################################################################
'##########################################################################

'Copy a windows bitmap of the requested size to the clipboard
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire bitmap:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono bitmap should be 1-bit (black or white)
'Public Function CopyBitmap(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Boolean
'    On Error GoTo BitmapError
'    Dim TheImage As New StdPicture
'    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        'Put the image on the Windows clipboard
'        Clipboard.SetData TheImage, vbCFDIB
'        CopyBitmap = True
'        Exit Function
'    End If
'    Exit Function

'BitmapError:
'    CopyBitmap = False
'End Function

'Return a Picture object for the requested size
'Apparently, returning references to StdPicture objects doesn't work for .EXE servers
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire image:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono image should be 1-bit (black or white)
Public Function GetPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Object
    On Error GoTo PictureError
    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        Set GetPicture = TheImage
'        Exit Function
    End If
    Exit Function

PictureError:
    Set GetPicture = Nothing
End Function

'Implementation specific stuff
'Private function to return the bitmap from .Res file or .Bmp file
Private Function GetButtonPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean, TheImage As StdPicture) As Boolean
    On Error GoTo LoadError

        Dim idBitmap% 'BITMAP resource id in .Res file
        If LargeImage Then
            idBitmap% = 102
        Else
            idBitmap% = 101
        End If
        Set TheImage = LoadResPicture(idBitmap%, vbResBitmap)

    'Return the image
    GetButtonPicture = True
    Exit Function

LoadError:
    If boolDebug Then
'        MsgBox "Error loading bitmap: " & Err.Description
    End If
    GetButtonPicture = False
End Function

'Private Function GetLMPicture() As Object
Public Function GetLMPicture() As Object
Dim TheImage As StdPicture
'MsgBox ("1111")
    Set TheImage = LoadResPicture(103, vbResBitmap)
    Set GetLMPicture = TheImage
End Function

'##########################################################################
'##########################################################################
'##########################################################################
'##########################################################################

'Return a description string for this package of tools
Public Property Get Description() As String
    Description = LoadResString(115) '"Boolean2D tool"
End Property
'Returns true if tool is correctly initialized
Public Function Initialize(ByVal Tool As Object) As Boolean
On Error GoTo ErrorHandler
    Set objApp = Tool.Application
    Set theToolEvents = objApp
    ARCTYPE = LoadResString(130)
    GRAPHICTYPE = LoadResString(129)
    CIRCLETYPE = LoadResString(132)
    DATATYPE = LoadResString(131)
    TEXTTYPE = LoadResString(133)
    NONETYPE = LoadResString(134)
    INSERTTYPE = LoadResString(135)
    SOLIDTYPE = LoadResString(136)
    SURFACETYPE = LoadResString(137)
    SELSECONDG = LoadResString(138)
    iConnectId = -1
    iActTool = -1
    Initialize = True
    Exit Function
ErrorHandler:
'    MsgBox ("Run")
'    MsgBox Err.Msg

End Function
'Returns true if tool is correctly initialized
Public Function UpdateToolStatus(ByVal Tool As Object, Enabled As Boolean, Checked As Boolean) As Boolean
    Enabled = True 'Could do a test here to determine whether to disable the button/menu item
    If iConnectId = -1 Then
        Checked = False  'Could do a test here to determine whether to check the button/menu item
    Else
        If Tool.Index = iActTool Then
            Checked = True
        Else
            Checked = False
        End If
    End If
    UpdateToolStatus = True
End Function

'Called to perform tool function
Public Function Run(ByVal Tool As Object) As Boolean
    On Error GoTo ErrorHandler
Dim theXTool As Tool
    Set theXTool = Tool
    theXTool.Application.ActiveDrawing.Graphics.Unselect
    ResNum = 0
    If iConnectId <> -1 Then
        objApp.DisconnectEvents iConnectId
        AddLM False
        iConnectId = -1
        iActTool = -1
        theToolEvents.ToolChangePrompt Me, "", False
    Else
        iConnectId = objApp.ConnectEvents(Me, EventMask)
        iActTool = theXTool.Index
        AddLM True
        theToolEvents.ToolChangePrompt Me, LoadResString(106), False '"Select First graphic", False
    End If
    Set theXTool = Nothing

    Exit Function

ErrorHandler:
'    MsgBox ("Run")
'    MsgBox Err.Msg

End Function
'Fill arrays with information about tools in the package
'Return the number of tools in the package
Public Function GetToolInfo(CommandNames As Variant, MenuCaptions As Variant, StatusPrompts As Variant, _
    ToolTips As Variant, Enabled As Variant, WantsUpdates As Variant) As Long
    ReDim CommandNames(NUM_TOOLS)
    ReDim MenuCaptions(NUM_TOOLS, 2)
    ReDim StatusPrompts(NUM_TOOLS, 2)
    ReDim ToolTips(NUM_TOOLS)
    ReDim Enabled(NUM_TOOLS)
    ReDim WantsUpdates(NUM_TOOLS)

    CommandNames(0) = LoadResString(101) '"Modify|2D Boolean Operations|Add"
    MenuCaptions(0, 0) = LoadResString(102) '"&Add"
    MenuCaptions(0, 1) = LoadResString(103) '"2D_Boolean"
    StatusPrompts(0, 0) = LoadResString(104) '"Adding 2D objects"
    StatusPrompts(0, 1) = "29676"
    ToolTips(0) = LoadResString(105) '"2D Boolean Operation Add"
    Enabled(0) = True
    WantsUpdates(0) = False

    CommandNames(1) = LoadResString(107) '"Modify|2D Boolean Operations|Subtract"
    MenuCaptions(1, 0) = LoadResString(108) '"&Subtract"
    MenuCaptions(1, 1) = LoadResString(103) '"2D_Boolean"
    StatusPrompts(1, 0) = LoadResString(109) '"Subtracting 2D objects"
    StatusPrompts(1, 1) = "29677"
    ToolTips(1) = LoadResString(110) '"2D Boolean Operation Subtract"
    Enabled(1) = True
    WantsUpdates(1) = False

    CommandNames(2) = LoadResString(111) '"Modify|2D Boolean Operations|Intersect"
    MenuCaptions(2, 0) = LoadResString(112) '"&Intersect"
    MenuCaptions(2, 1) = LoadResString(103) '"2D_Boolean"
    StatusPrompts(2, 0) = LoadResString(113) '"Intersecting 2D objects"
    StatusPrompts(2, 1) = "29678"
    ToolTips(2) = LoadResString(114) '"2D Boolean Operation Intersect"
    Enabled(2) = True
    WantsUpdates(2) = False

    GetToolInfo = NUM_TOOLS
End Function
Public Function RunTool(WhichTool As Tool)
    On Error Resume Next
'    GrFirst.Properties("Selected") = 0
    GrFirst.Properties("PenColor") = GrFirstPenColor
    GrFirst.Properties("BrushColor") = GrFirstBrushColor
    GrSecond.Properties("Selected") = 0
    iNSel = 0
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Vi.Refresh
    Call Finish

End Function

Public Function BeforeExit(WhichApplication As Application, Cancel As Boolean)
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    Call Finish
End Function
Public Function DrawingNew(WhichDrawing As Drawing)
    On Error Resume Next
'    GrFirst.Properties("Selected") = 0
    GrFirst.Properties("PenColor") = GrFirstPenColor
    GrFirst.Properties("BrushColor") = GrFirstBrushColor
    GrSecond.Properties("Selected") = 0
    iNSel = 0
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Vi.Refresh
    Call Finish
End Function
Public Function DrawingOpen(WhichDrawing As Drawing)
    On Error Resume Next
'    GrFirst.Properties("Selected") = 0
    GrFirst.Properties("PenColor") = GrFirstPenColor
    GrFirst.Properties("BrushColor") = GrFirstBrushColor
    GrSecond.Properties("Selected") = 0
    iNSel = 0
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Vi.Refresh
    Call Finish
End Function
Public Function DrawingActivate(WhichDrawing As Drawing)
    On Error Resume Next
'    GrFirst.Properties("Selected") = 0
    GrFirst.Properties("PenColor") = GrFirstPenColor
    GrFirst.Properties("BrushColor") = GrFirstBrushColor
    GrSecond.Properties("Selected") = 0
    iNSel = 0
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Vi.Refresh
    Call Finish
End Function
Public Function DrawingDeactivate(WhichDrawing As Drawing)
    On Error Resume Next
'    GrFirst.Properties("Selected") = 0
    GrFirst.Properties("PenColor") = GrFirstPenColor
    GrFirst.Properties("BrushColor") = GrFirstBrushColor
    GrSecond.Properties("Selected") = 0
    iNSel = 0
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Vi.Refresh
    Call Finish
End Function
Public Function DrawingBeforeClose(WhichDrawing As Drawing, Cancel As Boolean)
    On Error Resume Next
'    GrFirst.Properties("Selected") = 0
    GrFirst.Properties("PenColor") = GrFirstPenColor
    GrFirst.Properties("BrushColor") = GrFirstBrushColor
    GrSecond.Properties("Selected") = 0
    iNSel = 0
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Vi.Refresh
    Call Finish
End Function
Public Function DrawingBeforeSave(WhichDrawing As Drawing, SaveAs As Boolean, Cancel As Boolean)
    On Error Resume Next
'    GrFirst.Properties("Selected") = 0
    GrFirst.Properties("PenColor") = GrFirstPenColor
    GrFirst.Properties("BrushColor") = GrFirstBrushColor
    GrSecond.Properties("Selected") = 0
    iNSel = 0
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Vi.Refresh
    Call Finish
End Function

Public Function MouseDown(WhichDrawing As Drawing, WhichView As View, WhichWindow As Window, Button As ImsiMouseButton, Shift As Long, x As Long, y As Long, Cancel As Boolean)
    Set Drs = objApp.Drawings
    Set Dr = WhichDrawing
    Set Grs = Dr.Graphics
    Set Vis = Dr.Views
    Set Vi = WhichView

    If Vi.ViewWidth < 0.001 Then
        Eps = 0.01 * Eps0
    Else
        Eps = Eps0
    End If
    Result = True
    Vi.ScreenToView x, y, xClick, yClick
    If Button = imsiLeftButton Then
        Cancel = True
        If iNSel = 0 Then
            If PickObject(GrFirst, iNSel) = False Then
                iNSel = 0
'                GrFirst.Properties("Selected") = False
                GrFirst.Properties("PenColor") = GrFirstPenColor
                GrFirst.Properties("BrushColor") = GrFirstBrushColor
                Vi.Refresh
                If TryAgain = False Then
                    theToolEvents.ToolChangePrompt Me, "", False  '????
                    objApp.DisconnectEvents iConnectId       '????
                    iConnectId = -1       '????
                    AddLM False
                    Cancel = True   '????
                    Call Finish
                    Exit Function   '????
                Else
                    TryAgain = False
                End If
            Else
                theToolEvents.ToolChangePrompt Me, "", False
                'theToolEvents.ToolChangePrompt Me, "Select Second graphic", False
                theToolEvents.ToolChangePrompt Me, SELSECONDG, False

                Result = True
                iNSel = iNSel + 1
                Cancel = True
                Exit Function
            End If
        End If
        If iNSel = 1 Then
            If PickObject(GrSecond, iNSel) = False Then
                On Error Resume Next
                If TryAgain = False Then
'                    GrFirst.Properties("Selected") = False
                    GrFirst.Properties("PenColor") = GrFirstPenColor
                    GrFirst.Properties("BrushColor") = GrFirstBrushColor
                    GrSecond.Properties("Selected") = False
                    Result = False
                    iNSel = 0
                    theToolEvents.ToolChangePrompt Me, "", False  '????
                    objApp.DisconnectEvents iConnectId       '????
                    iConnectId = -1       '????
                    AddLM False
                    Cancel = True   '????
                    Vi.Refresh
                    Call Finish
                    Exit Function   '????
                Else
                    TryAgain = False
                    GrSecond.Properties("Selected") = False
                    GrFirst.Properties("PenColor") = QBColor(13)
'                    GrFirst.Properties("Selected") = True
                    Vi.Refresh
                End If
            Else
                iNSel = 0
                Result = True
                On Error Resume Next
'                GrFirst.Properties("Selected") = 0
                GrFirst.Properties("PenColor") = GrFirstPenColor
                GrFirst.Properties("BrushColor") = GrFirstBrushColor
                GrSecond.Properties("Selected") = 0
                theToolEvents.ToolChangePrompt Me, "", False
                objApp.DisconnectEvents iConnectId
                iConnectId = -1
                GrFirstPenColor = GrFirst.Properties("PenColor")
                GrFirstPenStyle = GrFirst.Properties("PenStyle")
                Call BoolPlane
                nClick = 0
                AddLM False
                iNSel = 0
            End If
        End If
        Cancel = True
    Else
        Cancel = False
    End If
End Function

Public Function Cancel(DoItPlease As Boolean, CanCancel As Boolean)
    If (DoItPlease) Then
        If iConnectId <> -1 Then
            theToolEvents.ToolChangePrompt Me, "", False
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
        End If
        Call Finish
    End If
    CanCancel = True
End Function
Public Function UpdateUndo(AllowsUndo As Boolean)
    AllowsUndo = False
End Function

Private Sub Class_Terminate()
    If (Not theToolEvents Is Nothing) Then
        Set theToolEvents = Nothing
    End If
    If (Not objApp Is Nothing) Then
        Set objApp = Nothing
    End If
End Sub

Private Function AddActToolLM(iTool As Long, bAdd As Boolean)
'  AddLM bAdd
End Function
'Public Function MouseMove(WhichDrawing As Drawing, WhichView As View, WhichWindow As Window, Shift As Long, x As Long, y As Long, Cancel As Boolean)
'    Cancel = True
'End Function
Private Function AddLM(bAdd) As Boolean
Dim Captions(0 To 0) As String
Dim Prompts(0 To 0, 0 To 1) As String
Dim Enabled(0 To 0) As Boolean
Dim Checked(0 To 0) As Boolean

 Dim varCaptions As Variant
 Dim varPrompts As Variant
 Dim varEnabled As Variant
 Dim varChecked As Variant
    If (bAdd) Then
        Captions(0) = LoadResString(116) '"Finish Boolean2D"
        Prompts(0, 0) = LoadResString(116) '"Finish Boolean2D"
        If iActTool = 0 Then
            Prompts(0, 1) = "95140"
        End If
        If iActTool = 1 Then
            Prompts(0, 1) = "95141"
        End If
        If iActTool = 2 Then
            Prompts(0, 1) = "95142"
        End If
        Enabled(0) = True
        Checked(0) = False

        varCaptions = Captions
        varPrompts = Prompts
        varEnabled = Enabled
        varChecked = Checked
        theToolEvents.ToolChangeCommands Me, 1, varCaptions, varPrompts, varEnabled, varChecked, True
    Else
       theToolEvents.ToolChangeCommands Me, 0, , , , , False
    End If
End Function

Public Function DoLMCommand(cmdInd As Long)
    If cmdInd = 0 Then
        If iConnectId <> -1 Then
            theToolEvents.ToolChangePrompt Me, "", False
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
            iActTool = -1
            iNSel = 0
            AddLM False

        End If
        On Error Resume Next
'        GrFirst.Properties("Selected") = False
        GrFirst.Properties("PenColor") = GrFirstPenColor
        GrFirst.Properties("BrushColor") = GrFirstBrushColor
        GrSecond.Properties("Selected") = False
        Vi.Refresh
        Set GrFirst = Nothing
        Set GrSecond = Nothing

        Call Finish
    End If
End Function

Private Function BoolPlane() As Boolean
    On Error GoTo ErrorHandler
   BoolPlane = True
ReDim ContCom.xVer(500)
ReDim ContCom.yVer(500)
ReDim Dist(10)
ReDim BetaMin(10)
Dim IntP As IntPoint
ReDim IntP.xInt(100)
ReDim IntP.yInt(100)
ReDim IntP.iInt(100)
ReDim IntP.jInt(100)
ReDim IntP.Pr(100)
Dim Ver As Object

Dim x#, y#
Dim NumGr As Long, nV As Long, i As Long, j As Long, k As Long
Dim Res%
    hDrawing = TCWDrawingActive() ' !!!!!!!!!!!!!!!!

    If iActTool = 0 Then
        Operation = "Add"
    End If
    If iActTool = 1 Then
        Operation = "Subtract"
    End If
    If iActTool = 2 Then
        Operation = "Intersect"
    End If
    If DifferentWorkPlanes = True Then
        Beep
'        MsgBox "Selected objects are on different WorkPlanes . The operation will be canceled.", 0, "2D Boolean Operations"
        MsgBox LoadResString(117), 0, LoadResString(118)
        GoTo ENDRUN
    End If

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Initalization disposition contours one to other -
'    "Intersect" - contour are intersected
'    "Intenal" - this contour is internal to other and lies into other
'    "External" - this contour is external to other and other contour lies into it
'    "Nonintersect" - all point this contour lies outside of other contour
Dim Loc As String
    ReDim Cont0.Loc(n1Int)
    For i = 0 To n0Int - 1
        ReDim Cont0Int(i).Loc(n1Int)
    Next i

    ReDim Cont1.Loc(n0Int)
    For i = 0 To n1Int - 1
        ReDim Cont1Int(i).Loc(n0Int)
    Next i
    Loc = Location(Cont0, Cont1)
    If Loc = "Error" Then GoTo ENDRUN
    Cont0.Loc(0) = Loc
'MsgBox ("Loc=" & Loc)
    For i = 1 To n1Int
        Loc = Location(Cont0, Cont1Int(i - 1))
        If Loc = "Error" Then GoTo ENDRUN
        Cont0.Loc(i) = Loc
    Next i

    For i = 0 To n0Int - 1
        Loc = Location(Cont0Int(i), Cont1)
        If Loc = "Error" Then GoTo ENDRUN
        Cont0Int(i).Loc(0) = Loc

        For j = 1 To n1Int
            Loc = Location(Cont0Int(i), Cont1Int(j - 1))
            If Loc = "Error" Then GoTo ENDRUN
            Cont0Int(i).Loc(j) = Loc
        Next j
    Next i

    Loc = Location(Cont1, Cont0)
    If Loc = "Error" Then GoTo ENDRUN
    Cont1.Loc(0) = Loc
    For i = 1 To n0Int
        Loc = Location(Cont1, Cont0Int(i - 1))
        If Loc = "Error" Then GoTo ENDRUN
        Cont1.Loc(i) = Loc
    Next i
    For i = 0 To n1Int - 1
        Loc = Location(Cont1Int(i), Cont0)
        If Loc = "Error" Then GoTo ENDRUN
        Cont1Int(i).Loc(0) = Loc
        For j = 1 To n0Int
            Loc = Location(Cont1Int(i), Cont0Int(j - 1))
            If Loc = "Error" Then GoTo ENDRUN
            Cont1Int(i).Loc(j) = Loc
        Next j
    Next i
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

'Define disposition contours one to other - Internal,External,Intersected
'Two contours are intersected if is intersected any two segments of both contours
Dim Position As String
Dim xi#, yi#, xi1#, yi1#, xj#, yj#, xj1#, yj1#
Dim ai#, bi#, di#, aj#, bj#, dj#
Dim Sign%
'    Form1.Show 1

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'  Begin ADD two contours
 '   GrFirst.Unselect
 '   GrSecond.Unselect

Dim ResCont(100) As ContGeo
Dim nRes As Long
'Vi.Refresh
    If Operation = "Add" Then
        If Cont0.Loc(0) = "NonIntersect" Then
        ' If Both contours are nonintersected
            Beep
'            MsgBox "Contours of selected objects don't intersect.The operation is discarded.", 0, "2D Boolean Operations"
            MsgBox LoadResString(119), 0, LoadResString(118)
            GoTo ENDRUN
        Else

Dim GcontAdd As Object
Dim ContAdd As ContGeo
Dim ContIntAdd(100) As ContGeo
Dim NumContIntAdd%
Dim GconIntAdd(100) As Object ' Internal contouts on the common contour

            Call LeftPointTwoGrap(Cont0, Cont1, x, y)

            If InitNew(Cont0, Cont1, 2, x, y, ContAdd) = False Then GoTo ENDRUN
         ' External contour fo ADD
        End If
        NumContIntAdd = -1

Dim GcontAddInt(100) As Object
Dim ContAddInt(100) As ContGeo
Dim NumContAddInt As Long
            NumContAddInt = -1
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

'Define new internal contours which are result of intersection external contours of the both selected graphics
' Define Contour's Vertex which is into another contour
Dim VertexIntoContours As Boolean  ' If Point(x,y) is into both contours then VertexIntoContour=True

ADDINT:
            VertexIntoContours = False
' NumContInter - count of before created contours
' ContInter - before created contours
' x,y - coordinates of the point which lies into both contours - GrFirst and GrSecond
' VertexIntoContours = True - if exists such point
            Call AddInternal(ContAdd, NumContAddInt, ContAddInt, x, y, VertexIntoContours)

            If VertexIntoContours = True Then
                NumContAddInt = NumContAddInt + 1
                If InitNew(Cont0, Cont1, 2, x, y, ContAddInt(NumContAddInt)) = False Then GoTo ENDRUN
                VertexIntoContours = False

                GoTo ADDINT
            End If
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
' edit all internal contours of the first selected graphic as result intersection
' with external contour of the second selected graphic
Dim ContC(50) As ContGeo
Dim nC As Long
            For i = 0 To n0Int - 1
                If Cont1.Loc(i + 1) = "Intersect" Then
                    Call TwoContInter(Cont0Int(i), Cont1, IntP)
                    nC = -1
ADD1:
                    VertexIntoContours = False
                    Call Subtract(Cont0Int(i), Cont1, nC, ContC, x, y, IntP, VertexIntoContours)
                    If VertexIntoContours = True Then
                        nC = nC + 1
                        If InitNew(Cont0Int(i), Cont1, 2, x, y, ContC(nC)) = False Then GoTo ENDRUN
                        GoTo ADD1
                    End If
                    For k = 0 To nC
                        NumContAddInt = NumContAddInt + 1
                        ContAddInt(NumContAddInt) = ContC(k)
                    Next k
                End If
            Next i

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
' edit all internal contours of the Second selected graphic as result intersection
' with external contout of the First selected graphic

            For i = 0 To n1Int - 1
                If Cont0.Loc(i + 1) = "Intersect" Then
                    Call TwoContInter(Cont1Int(i), Cont0, IntP)
                    nC = -1
ADD2:
                    VertexIntoContours = False
                    Call Subtract(Cont1Int(i), Cont0, nC, ContC, x, y, IntP, VertexIntoContours)
                    If VertexIntoContours = True Then
                        nC = nC + 1
                        If InitNew(Cont1Int(i), Cont0, 2, x, y, ContC(nC)) = False Then GoTo ENDRUN
                        GoTo ADD2
                    End If
                    For k = 0 To nC
                        NumContAddInt = NumContAddInt + 1
                        ContAddInt(NumContAddInt) = ContC(k)
                    Next k
                End If
            Next i

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
' draw holes of the first graphic if its are NonIntersect with Second external
' contour of the second graphic
            For i = 0 To n0Int - 1
                If Cont1.Loc(i + 1) = "NonIntersect" Then
                    NumContAddInt = NumContAddInt + 1
                    ContAddInt(NumContAddInt) = Cont0Int(i)
                End If
            Next i

 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
' draw holes of the Second graphic if its are NonIntersect with First external
' contour of the second graphic

            For i = 0 To n1Int - 1
                If Cont0.Loc(i + 1) = "NonIntersect" Then
                    NumContAddInt = NumContAddInt + 1
                    ContAddInt(NumContAddInt) = Cont1Int(i)
                End If
            Next i

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
' edit all internal contours of the first selected graphic as result intersection
' with Internal contout of the second selected graphic
            For i = 0 To n0Int - 1
                For j = 0 To n1Int - 1
                    If Cont0Int(i).Loc(j + 1) = "Intersect" Then
                        Call PointInIn(Cont0Int(i), Cont1Int(j), x, y, VertexIntoContours)
                        If VertexIntoContours = False Then GoTo ADD3
                        NumContAddInt = NumContAddInt + 1
                        If InitNew(Cont0Int(i), Cont1Int(j), 2, x, y, ContAddInt(NumContAddInt)) = False Then GoTo ENDRUN
                    End If
ADD3:
                Next j
            Next i

' Draw  internal contours of the first graphic internal to internal Holes
'  of the second selected graphic

            For i = 0 To n0Int - 1
                For j = 0 To n1Int - 1
                    If Cont0Int(i).Loc(j + 1) = "Internal" Then
                        NumContAddInt = NumContAddInt + 1
                        ContAddInt(NumContAddInt) = Cont0Int(i)
                    End If
                Next j
            Next i

' Draw  internal contours of the Second graphic internal to internal Holes
'  of the First selected graphic

            For i = 0 To n1Int - 1
                For j = 0 To n0Int - 1
                    If Cont1Int(i).Loc(j + 1) = "Internal" Then
                        NumContAddInt = NumContAddInt + 1
                        ContAddInt(NumContAddInt) = Cont1Int(i)
                    End If
                Next j
            Next i

' Draw Rresulting contours with unvisible lines
            nRes = NumContAddInt + 1
            ResCont(0) = ContAdd
            For i = 0 To NumContAddInt
                ResCont(i + 1) = ContAddInt(i)
            Next i
'MsgBox (CStr(nRes))
'        Res = TCWUndoRecordStart(hDrawing, "Boolean2DAdd") '!!!!!!!

            Call HorizontalIntersection(ResCont, nRes, 0)
Dim hMatrFirst As Long, hMatrSecond As Long
Dim hGrFirst As Long, hGrSecond As Long
            hGrFirst = TCWGraphicAt(hDrawing, GrFirst.Index)
            hMatrFirst = GraphicGetMatrix(hGrFirst)
            hGrSecond = TCWGraphicAt(hDrawing, GrSecond.Index)
Dim Res1 As Boolean
            Res1 = GraphicSetMatrix(hGrSecond, hMatrFirst)
' Create UNDO
'            Res = TCWUndoRecordStart(hDrawing, "Boolean2DAdd") '!!!!!!!
            Res = TCWUndoRecordStart(hDrawing, LoadResString(120)) '!!!!!!!
            For i = 0 To ResNum - 1
                Set Gr = Grs.GraphicFromID(ResID(i))
                Gr.Layer = GrFirst.Layer
                hGraphic = TCWGraphicAt(hDrawing, Gr.Index)
                Res = TCWUndoRecordAddGraphic(hDrawing, hGraphic) '!!!!!!!!!!!!
            Next i
            hGraphic = TCWGraphicAt(hDrawing, GrFirst.Index) '!!!!!!!!!!
            Res = TCWUndoRecordAddGraphic(hDrawing, hGraphic) '!!!!!!!!!!!!

            hGraphic = TCWGraphicAt(hDrawing, GrSecond.Index) '!!!!!!!!!!!
            Res = TCWUndoRecordAddGraphic(hDrawing, hGraphic) '!!!!!!!!!!!

            Res = TCWUndoRecordEnd(hDrawing)
            GrFirst.Deleted = True
            GrSecond.Deleted = True
'        Vi.Refresh

    End If ' End ADD
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'  Begin INTERSECT two contours
    If Operation = "Intersect" Then
        If Cont0.Loc(0) = "NonIntersect" Then
            Beep
'            MsgBox "Contours of selected objects don't intersect.The operation is discarded.", 0, "2D Boolean Operations"
            MsgBox LoadResString(119), 0, LoadResString(118)
            GoTo ENDRUN
        End If
Dim GcontInter(100) As Object
Dim ContInter(100) As ContGeo
Dim NumContInter As Long
            NumContInter = -1

        If Cont0.Loc(0) = "Intersect" Then

            If TwoContInter(Cont0, Cont1, IntP) = False Then GoTo ENDRUN

' Define Contour's Vertex which is into another contour
'Dim VertexIntoContours As Boolean  ' If Point(x,y) is into both contours then VertexIntoContour=True
INTER:
            VertexIntoContours = False
            Call Intersect(Cont0, Cont1, NumContInter, ContInter, x, y, IntP, VertexIntoContours)
            If VertexIntoContours = True Then
                NumContInter = NumContInter + 1
' MsgBox ("x=" & CStr(x) & "  y=" & CStr(y))
                Call InitNew(Cont0, Cont1, 2, x, y, ContInter(NumContInter))

                VertexIntoContours = False
                GoTo INTER
            End If
        End If

' if external contour of the First graphic is into external contour of the Second graphic
        If Cont0.Loc(0) = "Internal" Then
            NumContInter = NumContInter + 1
            ContInter(NumContInter) = Cont0
        End If

' if external contour of the Second graphic is into external contour of the First graphic
        If Cont1.Loc(0) = "Internal" Then
            NumContInter = NumContInter + 1
            ContInter(NumContInter) = Cont1
        End If
'    Res = TCWUndoRecordStart(hDrawing, "Boolean2DIntersect") '!!!!!!!

        Call AddAllHoles(ContInter, NumContInter)
' Create UNDO
'        Res = TCWUndoRecordStart(hDrawing, "Boolean2DIntersect") '!!!!!!!
        Res = TCWUndoRecordStart(hDrawing, LoadResString(121)) '!!!!!!!
        For i = 0 To ResNum - 1
            Set Gr = Grs.GraphicFromID(ResID(i))
            Gr.Layer = GrFirst.Layer
            hGraphic = TCWGraphicAt(hDrawing, Gr.Index)
            Res = TCWUndoRecordAddGraphic(hDrawing, hGraphic) '!!!!!!!!!!!!
        Next i
        hGraphic = TCWGraphicAt(hDrawing, GrFirst.Index)
        Res = TCWUndoRecordAddGraphic(hDrawing, hGraphic) '!!!!!!!!!!!!
        hGraphic = TCWGraphicAt(hDrawing, GrSecond.Index)
        Res = TCWUndoRecordAddGraphic(hDrawing, hGraphic) '!!!!!!!!!!!
        Res = TCWUndoRecordEnd(hDrawing)
        GrFirst.Deleted = True
        GrSecond.Deleted = True
'        Vi.Refresh

    End If ' End Intersection
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'  Begin Subtract two contours
    If Operation = "Subtract" Then

Dim j1 As Long
' If Contours are not intersected and have not common points
        If Cont0.Loc(0) = "NonIntersect" Or Cont0.Loc(0) = "Internal" Then
            Beep
'            MsgBox "Contours of selected objects don't intersect.The operation is discarded.", 0, "2D Boolean Operations"
            MsgBox LoadResString(119), 0, LoadResString(118)
            GoTo ENDRUN
        End If
Dim GcontSubstr(100) As Object
Dim ContSubstr(100) As ContGeo
Dim NumContSubstr As Long
Dim NumContSubstr0 As Long
Dim NumContSubstrEnd As Long
Dim GrSubRes As Graphic

            NumContSubstr = -1
Dim FlagSubInt As Boolean
            FlagSubInt = False

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

' if External contour of the Second graphic intersect External contour of the First
' graphic
        If Cont0.Loc(0) = "Intersect" Then
             If TwoContInter(Cont0, Cont1, IntP) = False Then GoTo ENDRUN
SUBST:
            VertexIntoContours = False
            Call Subtract(Cont0, Cont1, NumContSubstr, ContSubstr, x, y, IntP, VertexIntoContours)
            If VertexIntoContours = True Then
                NumContSubstr = NumContSubstr + 1
                Call InitNew(Cont0, Cont1, 2, x, y, ContCom)
' edit resulting contour sibtracting internal contouts of the First graphic which intersect
' external contour of the Second graphic
                For i = 0 To n0Int - 1
                    If Cont1.Loc(i + 1) = "Intersect" Then
                        Call PointInOut(ContCom, Cont0Int(i), x, y, VertexIntoContours)
                        If VertexIntoContours = False Then GoTo SUBST2
                        Call InitNew(ContCom, Cont0Int(i), 2, x, y, ContCom)
                    End If
SUBST2:
                Next i
'*****************************************************************************

                ContSubstr(NumContSubstr) = ContCom

 ' *******************************************************************************

 ' Add internal nonintersected holes of the First graphic into Resulting graphic
                NumContSubstr0 = NumContSubstr
                For i = 0 To n0Int - 1
                    If Cont1.Loc(i + 1) = "NonIntersect" Then
                        x = Cont0Int(i).xVer(0) + 100 * Eps
                        y = Cont0Int(i).yVer(0) + 100 * Eps
                        If PointInsideContouri(ContSubstr(NumContSubstr0), x, y) = 1 Then
                            NumContSubstr = NumContSubstr + 1
                            ContSubstr(NumContSubstr) = Cont0Int(i)
                        End If
                    End If
                Next i

                NumContSubstrEnd = NumContSubstr
Dim GrSubInd As Long
'MsgBox (" NumContSubstr0=" & CStr(NumContSubstr0) & "  NumContSubstrEnd=" & CStr(NumContSubstrEnd))
'                If NumContSubstrEnd > NumContSubstr0 Then
'                    Set GrSubRes = Grs.Add(11)
'                    For i = NumContSubstr0 To NumContSubstrEnd
'                        Set Gr = GrSubRes.Graphics.Add(11)
'                        For j = 0 To ContSubstr(i).NVer - 1
'                            Set Ver = Gr.Vertices.Add(ContSubstr(i).xVer(j), ContSubstr(i).yVer(j), 0)
'                        Next j
'                    Next i
'                Else
'                    Set Gr = Grs.Add(11)
'                    i = NumContSubstrEnd
'                    For j = 0 To ContSubstr(i).NVer - 1
'                        Set Ver = Gr.Vertices.Add(ContSubstr(i).xVer(j), ContSubstr(i).yVer(j), 0)
'                    Next j
'                End If

                nRes = -1
                For i = NumContSubstr0 To NumContSubstrEnd
                    ResCont(i - NumContSubstr0) = ContSubstr(i)
                    nRes = nRes + 1
                Next i
'        Res = TCWUndoRecordStart(hDrawing, "Boolean2DSubtract") '!!!!!!!

                If nRes > -1 Then
                    Call HorizontalIntersection(ResCont, nRes, 0)
                End If

                VertexIntoContours = False

                GoTo SUBST
            End If

' ********************************************************************************
' ********************************************************************************
' If Holes of the Second graphic intersect external contour of the First graphic
            For i = 0 To n1Int - 1
                If Cont1Int(i).Loc(0) = "Intersect" Then
                    NumContSubstr = NumContSubstr + 1
                    NumContSubstr0 = NumContSubstr
                    Call PointInIn(Cont0, Cont1Int(i), x, y, VertexIntoContours)
                    If VertexIntoContours = False Then GoTo SUB0

                    Call InitNew(Cont0, Cont1Int(i), 2, x, y, ContCom)
                    For j = 0 To n0Int - 1
                        Cont0Int(j).Pr = False
                    Next j
                    For j = 0 To n0Int - 1
                        If Cont0Int(j).Loc(i + 1) = "Intersect" Then
                            Call TwoContInter(ContCom, Cont0Int(j), IntP)
                            If IntP.nInt > 1 Then
                                Cont0Int(j).Pr = True
                                GoTo SUB2
                            End If
                            Call PointInOut(ContCom, Cont0Int(j), x, y, VertexIntoContours)
                            If VertexIntoContours = False Then GoTo SUB2
                            Call InitNew(ContCom, Cont0Int(j), 2, x, y, ContCom)
                       End If
SUB2:
                    Next j
Dim ContCi(50) As ContGeo
Dim kk As Long, NSel As Long, ni As Long
Dim xInt#, yInt#, fi#
                    nC = 0
                    ContC(nC) = ContCom
                    ContC(nC).Pr = True
                    For j = 0 To n0Int - 1
                        If Cont0Int(j).Pr = True Then
                            For kk = 0 To nC
                                If ContC(kk).Pr = True And TwoContInter(ContC(kk), Cont0Int(j), IntP) = True Then GoTo WW
                            Next kk
                            GoTo WW1
WW:
                            NSel = kk
                            ContCom = ContC(NSel)
                            ContC(NSel).Pr = False
                            ni = -1
                            For k = 0 To IntP.nInt
                                xInt = IntP.xInt(k)
                                yInt = IntP.yInt(k)
                                If ni = -1 Then GoTo WW2
                                For kk = 0 To ni
                                    If PointIntoContouri(ContCi(kk), xInt, yInt) = 1 Then GoTo WW4
                                Next kk
WW2:
                                For fi = 0.5 To 2 * Pi + 0.5 Step 2 * Pi / 30
                                    x = xInt + 10000 * Eps * Cos(fi)
                                    y = yInt + 10000 * Eps * Sin(fi)
                                    If PointInsideContouri(ContCom, x, y) = 1 And PointIntoContouri(Cont0Int(j), x, y) = 0 Then GoTo WW3
                                Next fi
                                GoTo WW4
WW3:
                                ni = ni + 1
                                Call InitNew(ContCom, Cont0Int(j), 2, x, y, ContCi(ni))
WW4:
                            Next k
                            For k = 0 To ni
                                ContC(nC + 1 + k) = ContCi(k)
                                ContC(nC + 1 + k).Pr = True
                            Next k
                            nC = nC + 1 + ni
                        End If
WW1:
                    Next j

                    For k = 0 To nC
                        If ContC(k).Pr = True Then
                            ContSubstr(NumContSubstr0) = ContC(k) 'ContCom
 ' Add internal nonintersected holes of the First graphic into Resulting graphic
                            For j = 0 To n0Int - 1
                                If Cont0Int(j).Loc(i + 1) = "Internal" Then
                                    x = Cont0Int(j).xVer(0)
                                    y = Cont0Int(j).yVer(0)

                                    If PointInsideContouri(ContSubstr(NumContSubstr0), x, y) = 1 Then
                                        NumContSubstr = NumContSubstr + 1
                                        ContSubstr(NumContSubstr) = Cont0Int(j)
                                    End If
                                End If
                            Next j

                            NumContSubstrEnd = NumContSubstr

                            nRes = -1
                            For j = NumContSubstr0 To NumContSubstrEnd
                                ResCont(j - NumContSubstr0) = ContSubstr(j)
                                nRes = nRes + 1
                            Next j
'         Res = TCWUndoRecordStart(hDrawing, "Boolean2DSubtract") '!!!!!!!
                           If nRes > -1 Then
                                Call HorizontalIntersection(ResCont, nRes, 0)
                            End If

WWWW:
                            VertexIntoContours = False
                        End If
                    Next k
                End If ' if intersect
SUB0:
            Next i

EEEE:
'********************************************************************************

' If Holes of the Second graphic are internal contours for the First graphic
            For i = 0 To n1Int - 1
                If Cont1Int(i).Loc(0) = "Internal" Then
                    For j = 0 To n0Int - 1
                        If Cont1Int(i).Loc(j + 1) = "Internal" Then GoTo SUB5
                    Next j
                    ContCom = Cont1Int(i)
                    For j = 0 To n0Int - 1
                        If Cont0Int(j).Loc(i + 1) = "Intersect" Then
                            Call PointInOut(ContCom, Cont0Int(j), x, y, VertexIntoContours)
                            If VertexIntoContours = False Then GoTo SUB4
                            Call InitNew(ContCom, Cont0Int(j), 2, x, y, ContCom)
                            GoTo SUB4
                       End If
SUB4:
                    Next j
'                    GoTo SUB5
SUB41:
                    If ContCom.NVer < 4 Then GoTo SUB5
                    Set Gr = Grs.Add(11)
                    Gr.Properties("Thickness") = 0
                    With Gr.Vertices
                        For j = 0 To ContCom.NVer - 2
                            .Add ContCom.xVer(j), ContCom.yVer(j), 0
                        Next j
                        .AddClose
                    End With
                    Gr.Properties("PenColor") = GrFirstPenColor
                    Gr.Properties("PenStyle") = GrFirstPenStyle
Dim GrFirstPenWidth As Variant
                    GrFirstPenWidth = GrFirst.Properties("PenWidth")
                    Gr.Properties("PenWidth") = GrFirstPenWidth
Dim BrStyle$, BrColor As Long
                    BrStyle = GrFirst.Properties("BrushStyle")
                    BrColor = GrFirst.Properties("BrushColor")
                    If BrStyle <> NONETYPE Then
                        Gr.Properties("BrushStyle") = BrStyle
                        Gr.Properties("BrushColor") = BrColor
                    Else
                        Gr.Properties("BrushStyle") = ""
                    End If
                    hDrawing = TCWDrawingActive
                    hGraphic = TCWGraphicAt(hDrawing, Gr.Index)
                    hGrFirst = TCWGraphicAt(hDrawing, GrFirst.Index)
                    hMatrFirst = GraphicGetMatrix(hGrFirst)
                    Res1 = GraphicSetMatrix(hGraphic, hMatrFirst)

                    ResID(ResNum) = Gr.ID
                    ResNum = ResNum + 1
                End If ' if intersect
SUB5:
            Next i

        End If ' End if external contours both graphics are intersected

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

' If Second graphic is into First graphic
        If Cont0.Loc(0) = "External" Then

            NumContSubstr = NumContSubstr + 1
            ContSubstr(NumContSubstr) = Cont0

            FlagSubInt = False
            For i = 0 To n0Int - 1
                If Cont1.Loc(i + 1) = "Intersect" Then FlagSubInt = True
            Next i
' If External contour of second graphic not intersect with all internal contours
' of the First graphic
            If FlagSubInt = False Then
                'Draw External contour for Second graphic
                NumContSubstr = NumContSubstr + 1
                ContSubstr(NumContSubstr) = Cont1

                ' Draw Al Holes of the First graphic
                For i = 0 To n0Int - 1
                    NumContSubstr = NumContSubstr + 1
                    ContSubstr(NumContSubstr) = Cont0Int(i)

                Next i
            Else
' If External contour of second graphic intersect with some internal contours
' of the First graphic
                For i = 0 To n0Int - 1
                    ' Draw holes Of The First Graphic which nonintersect with External contour of the Second graphic
                    If Cont1.Loc(i + 1) = "NonIntersect" Then
                        NumContSubstr = NumContSubstr + 1
                        ContSubstr(NumContSubstr) = Cont0Int(i)

                    End If
                Next i
                ContCom = Cont1
                For i = 0 To n0Int - 1
                    If Cont1.Loc(i + 1) = "Intersect" Then
                        Call LeftPointTwoGrap(ContCom, Cont0Int(i), x, y)
                        Call InitNew(ContCom, Cont0Int(i), 2, x, y, ContCom)
                    End If
                Next i
                NumContSubstr = NumContSubstr + 1
                ContSubstr(NumContSubstr) = ContCom

            End If
' Add New created graphic
             nRes = -1
            For i = 0 To NumContSubstr
                ResCont(i) = ContSubstr(i)
                nRes = nRes + 1
            Next i
'         Res = TCWUndoRecordStart(hDrawing, "Boolean2DSubtract") '!!!!!!!
            If nRes > -1 Then
                Call HorizontalIntersection(ResCont, nRes, 0)
            End If

' ###############################################################
' If Holes of the Second graphic are internal contours for the First graphic
            For i = 0 To n1Int - 1
                    For j = 0 To n0Int - 1
                        If Cont1Int(i).Loc(j + 1) = "Internal" Then
                            GoTo SUB511
                        End If
                    Next j
                    ContCom = Cont1Int(i)
                    For j = 0 To n0Int - 1
                        If Cont0Int(j).Loc(i + 1) = "Intersect" Then
                            Call PointInOut(ContCom, Cont0Int(j), x, y, VertexIntoContours)
                            If VertexIntoContours = False Then GoTo SUB411
                            Call InitNew(ContCom, Cont0Int(j), 2, x, y, ContCom)
                            GoTo SUB411
                       End If
SUB411:
                    Next j
'                    GoTo SUB5
SUB4111:
                    If ContCom.NVer < 4 Then GoTo SUB511
                    Set Gr = Grs.Add(11)
                    Gr.Properties("Thickness") = 0
                    With Gr.Vertices
                        For j = 0 To ContCom.NVer - 2
                            .Add ContCom.xVer(j), ContCom.yVer(j), 0
                        Next j
                        .AddClose
                    End With

                    Gr.Properties("PenColor") = GrFirstPenColor
                    Gr.Properties("PenStyle") = GrFirstPenStyle
                    GrFirstPenWidth = GrFirst.Properties("PenWidth")
                    Gr.Properties("PenWidth") = GrFirstPenWidth
                    BrStyle = GrFirst.Properties("BrushStyle")
                    BrColor = GrFirst.Properties("BrushColor")
                    If BrStyle <> NONETYPE Then
                        Gr.Properties("BrushStyle") = BrStyle
                        Gr.Properties("BrushColor") = BrColor
                    Else
                        Gr.Properties("BrushStyle") = ""
                    End If
                    hDrawing = TCWDrawingActive
                    hGraphic = TCWGraphicAt(hDrawing, Gr.Index)
                    hGrFirst = TCWGraphicAt(hDrawing, GrFirst.Index)
                    hMatrFirst = GraphicGetMatrix(hGrFirst)
                    Res1 = GraphicSetMatrix(hGraphic, hMatrFirst)

                    ResID(ResNum) = Gr.ID
                    ResNum = ResNum + 1

SUB511:
            Next i
        End If
' Create UNDO
'        Res = TCWUndoRecordStart(hDrawing, "Boolean2DSubtract") '!!!!!!!
        Res = TCWUndoRecordStart(hDrawing, LoadResString(122)) '!!!!!!!
        For i = 0 To ResNum - 1
            Set Gr = Grs.GraphicFromID(ResID(i))
            Gr.Layer = GrFirst.Layer
            hGraphic = TCWGraphicAt(hDrawing, Gr.Index)
            Res = TCWUndoRecordAddGraphic(hDrawing, hGraphic) '!!!!!!!!!!!!
        Next i
        hGraphic = TCWGraphicAt(hDrawing, GrFirst.Index)
        Res = TCWUndoRecordAddGraphic(hDrawing, hGraphic) '!!!!!!!!!!!!
        hGraphic = TCWGraphicAt(hDrawing, GrSecond.Index)
        Res = TCWUndoRecordAddGraphic(hDrawing, hGraphic) '!!!!!!!!!!!
        Res = TCWUndoRecordEnd(hDrawing)
        GrFirst.Deleted = True
        GrSecond.Deleted = True
'        Vi.Refresh
    End If ' End Subtract
    Vi.Refresh
    Call Finish
    Exit Function

ENDRUN:
    BoolPlane = False
'    GrFirst.Properties("Selected") = False
    GrFirst.Properties("PenColor") = GrFirstPenColor
    GrFirst.Properties("BrushColor") = GrFirstBrushColor
    GrSecond.Properties("Selected") = False
    Vi.Refresh
    Call Finish
    Exit Function

ErrorHandler:
  '  MsgBox ("Func PlaneBool")
  '  MsgBox Err.Msg
    Call Finish

End Function

Private Sub Finish()
On Error GoTo ErrorHandler
    If Vers Is Nothing = False Then
        Set Vers = Nothing
    End If
    If GrFirst Is Nothing = False Then
        Set GrFirst = Nothing
    End If
    If GrSecond Is Nothing = False Then
        Set GrSecond = Nothing
    End If
    If Gcont Is Nothing = False Then
        Set Gcont = Nothing
    End If
    If GrDup Is Nothing = False Then
        Set GrDup = Nothing
    End If
    If Gr Is Nothing = False Then
        Set Gr = Nothing
    End If
    If Grs Is Nothing = False Then
        Set Grs = Nothing
    End If
    If PicEnt Is Nothing = False Then
        Set PicEnt = Nothing
    End If
    If PicRes Is Nothing = False Then
        Set PicRes = Nothing
    End If
    If Vi Is Nothing = False Then
        Set Vi = Nothing
    End If
    If Vis Is Nothing = False Then
        Set Vis = Nothing
    End If
    If Dr Is Nothing = False Then
        Set Dr = Nothing
    End If
    If Drs Is Nothing = False Then
        Set Drs = Nothing
    End If
    Exit Sub
ErrorHandler:
'    MsgBox ("Error Finish")
'    MsgBox Err.Msg

End Sub

' Function return 1 - if point lies inside line segment, or 0 - if point lies outside or on
' on bounds of line segment

Private Function PointIntoSegmenti(x1#, y1#, x2#, y2#, x#, y#) As Integer
Dim dx#, dy#, l#, sina#, cosa#
            PointIntoSegmenti = 0
            If Abs(x - x1) < Eps And Abs(y - y1) < Eps Then
                PointIntoSegmenti = 0
                Exit Function
            End If
            If Abs(x - x2) < Eps And Abs(y - y2) < Eps Then
                PointIntoSegmenti = 1
                Exit Function
            End If
Dim xLoc#, yLoc#
            dx = x2 - x1
            dy = y2 - y1
            l = Sqr(dx * dx + dy * dy)
            If l < Eps Then Exit Function
            sina = dy / l
            cosa = dx / l

            yLoc = (y - y1) * cosa - (x - x1) * sina
            xLoc = (y - y1) * sina + (x - x1) * cosa
            If Abs(yLoc) > 10 * Eps Then
                PointIntoSegmenti = 0
                Exit Function
            End If
            If xLoc > 0 And xLoc < l Then
                PointIntoSegmenti = 1
                Exit Function
            End If

End Function

Private Function PointIntoSegmentj(x1#, y1#, x2#, y2#, x#, y#) As Integer

Dim dx#, dy#, l#, sina#, cosa#
            PointIntoSegmentj = 0
            If Abs(x - x1) < Eps And Abs(y - y1) < Eps Then
                PointIntoSegmentj = 0
                Exit Function
            End If
            If Abs(x - x2) < Eps And Abs(y - y2) < Eps Then
                PointIntoSegmentj = 1
                Exit Function
            End If
Dim xLoc#, yLoc#
            dx = x2 - x1
            dy = y2 - y1
            l = Sqr(dx * dx + dy * dy)
            If l < Eps Then Exit Function
            sina = dy / l
            cosa = dx / l

            yLoc = (y - y1) * cosa - (x - x1) * sina
            xLoc = (y - y1) * sina + (x - x1) * cosa
            If Abs(yLoc) > 10 * Eps Then
                PointIntoSegmentj = 0
                Exit Function
            End If
            If xLoc > 0 And xLoc < l Then
                PointIntoSegmentj = 1
                Exit Function
            End If

End Function

' Define the point of intersection of two lines as solution of two simple equations
' a1*x+b1*y=d1
' a2*x+b2*y=d2
' xRes,yRes - coordinates of the intersection point
Private Sub SysLine(a1#, b1#, d1#, A2#, b2#, d2#, xRes#, yRes#)

Dim del#, delx#, dely#
    On Error GoTo ErrorHandler

    del = a1 * b2 - A2 * b1
    delx = d1 * b2 - b1 * d2
    dely = a1 * d2 - A2 * d1
    xRes = delx / del
    yRes = dely / del
    Exit Sub
ErrorHandler:
'    MsgBox ("Error SysLine")
'    MsgBox Err.Msg

End Sub

' define angle of declivity of the segment (xInt,yInt)-(x,y) to some axis
' axis is defined by it's start point -(xi,yi) and by angle to World axis -X (sina,cosa)
Private Function LocalBeta(sina#, cosa#, xi#, yi#, xInt#, yInt#, x#, y#) As Double
On Error GoTo ErrorHandler

Dim Rot%
Dim xLoc#, yLoc#, xin#, yin#
Dim l#, sinb#, cosb#, beta#
    Rot = 1

    yin = Rot * ((yInt - yi) * cosa - (xInt - xi) * sina)
    xin = Rot * ((yInt - yi) * sina + (xInt - xi) * cosa)

    yLoc = Rot * ((y - yi) * cosa - (x - xi) * sina)
    xLoc = Rot * ((y - yi) * sina + (x - xi) * cosa)

    l = Sqr((xLoc - xin) * (xLoc - xin) + (yLoc - yin) * (yLoc - yin))
    sinb = (yLoc - yin) / l
    cosb = (xLoc - xin) / l
    beta = Angle(sinb, cosb)
    If beta > Pi Then
        LocalBeta = beta - 2 * Pi
    Else
        LocalBeta = beta
    End If
    Exit Function

ErrorHandler:
'    MsgBox ("Error LocalBeta")
'    MsgBox Err.Msg

End Function

' define angle from Sin(a) and Cos(a)
Private Function Angle(sinb As Double, cosb As Double) As Double
On Error GoTo ErrorHandler

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
        Exit Function
ErrorHandler:
'    MsgBox ("Error Angle")
'    MsgBox Err.Msg

End Function

' Function return 1 - if point lies inside of the contour or on o bounds of the contour,
' or 0 - if point lies outside

Private Function PointIntoContour(Con As ContGeo, xc#, yc#) As Integer
On Error GoTo ErrorHandler

Dim nV As Long, i%
Dim x0#, y0#, x1#, y1#
Dim nInt%
Dim a1#, b1#, d1#
Dim xInt#, yInt#
    nV = Con.NVer
    nInt = 0
    For i = 0 To nV - 2
        y0 = Con.yVer(i)
        y1 = Con.yVer(i + 1)
        If y0 - yc > Eps And y1 - yc > Eps Then GoTo WW1
        If yc - y0 > Eps And yc - y1 > Eps Then GoTo WW1
        x0 = Con.xVer(i)
        x1 = Con.xVer(i + 1)
        If Abs(xc - x0) < Eps And Abs(yc - y0) < Eps Then
            PointIntoContour = 1
            Exit Function
        End If
        If Abs(xc - x1) < Eps And Abs(yc - y1) < Eps Then
            PointIntoContour = 1
            Exit Function
        End If
'********************************************************************
        If Abs(y1 - y0) > Eps And Abs(yc - y1) < Eps And xc - x1 > 10 * Eps Then
            nInt = nInt + 1
            GoTo WW1
        End If
'********************************************************************

        a1 = -(y1 - y0)
        b1 = x1 - x0
        If Abs(a1) < Eps And Abs(b1) < Eps Then GoTo WW1

        d1 = a1 * x0 + b1 * y0
        ' if segment is horizontal
        If Abs(b1) > Eps Then
            If Abs(a1 / b1) < 0.00001 Then
                If Abs(yc - y0) < Eps And PointIntoSegmenti(x0, y0, x1, y1, xc, yc) = 1 Then
                        PointIntoContour = 1
                        Exit Function
                Else
                    GoTo WW1
                End If
            End If
        End If
        yInt = yc
        ' if segment is vertical
        If Abs(a1) > Eps Then
            If Abs(b1 / a1) < 0.00001 Then
                xInt = x0
            Else
                xInt = (d1 - b1 * yInt) / a1
            End If
        End If
        If Abs(xc - xInt) < Eps And Abs(yc - yInt) < Eps And PointIntoSegmentj(x0, y0, x1, y1, xInt, yInt) = 1 Then
            PointIntoContour = 1
            Exit Function
        End If
        If Abs(xc - xInt) < Eps And Abs(yc - yInt) < Eps And PointIntoSegmentj(x0, y0, x1, y1, xInt, yInt) = 0 Then
            PointIntoContour = 0
            Exit Function
        End If

        If PointIntoSegmentj(x0, y0, x1, y1, xInt, yInt) = 1 And xc - xInt > 10 * Eps Then nInt = nInt + 1
WW1:
    Next i
    If nInt = 0 Or nInt = 2 Or nInt = 4 Or nInt = 6 Or nInt = 8 Or nInt = 10 Or nInt = 12 Then
        PointIntoContour = 0
    Else
        PointIntoContour = 1
    End If

    Exit Function
ErrorHandler:
'    MsgBox ("Error PointIntoContour")
'    MsgBox Err.Msg

End Function

' Function return 1 - if point lies inside of the contour ,
' or 0 - if point lies outside or on o bounds of the contour

Private Function PointInsideContour(Con As ContGeo, xc#, yc#) As Integer
On Error GoTo ErrorHandler

Dim nV As Long, i%
Dim x0#, y0#, x1#, y1#
Dim nInt%
Dim a1#, b1#, d1#
Dim xInt#, yInt#
    nV = Con.NVer
    nInt = 0
    For i = 0 To nV - 2
        y0 = Con.yVer(i)
        y1 = Con.yVer(i + 1)
        If y0 - yc > Eps And y1 - yc > Eps Then GoTo WW1
        If yc - y0 > Eps And yc - y1 > Eps Then GoTo WW1

        x0 = Con.xVer(i)
        x1 = Con.xVer(i + 1)
        If Abs(xc - x0) < Eps And Abs(yc - y0) < Eps Then
            PointInsideContour = 0
            Exit Function
        End If
        If Abs(xc - x1) < Eps And Abs(yc - y1) < Eps Then
            PointInsideContour = 0
            Exit Function
        End If
'********************************************************************
        If Abs(y1 - y0) > Eps And Abs(yc - y1) < Eps And xc - x1 > 10 * Eps Then
            nInt = nInt + 1
            GoTo WW1
        End If
'********************************************************************

        a1 = -(y1 - y0)
        b1 = x1 - x0
        d1 = a1 * x0 + b1 * y0
        If Abs(a1) < Eps And Abs(b1) < Eps Then GoTo WW1

        ' if segment is horizontal
        If Abs(b1) > Eps Then
            If Abs(a1 / b1) < 0.0001 Then
                If Abs(yc - y0) < Eps And PointIntoSegmenti(x0, y0, x1, y1, xc, yc) = 1 Then
                    PointInsideContour = 0
                    Exit Function
                Else
                    If Abs(a1 / b1) < 0.0001 And Abs(yc - y0) < Eps And x0 < xc And x1 < xc Then
                        nInt = nInt + 1
                    Else
                        GoTo WW1
                    End If
                End If
            End If
        End If
        yInt = yc
        ' if segment is vertical
        If Abs(a1) > Eps Then
            If Abs(b1 / a1) < 0.0001 Then
                xInt = x0
            Else
                xInt = (d1 - b1 * yInt) / a1
            End If
        End If

        If PointIntoSegmenti(x0, y0, x1, y1, xInt, yInt) = 1 And xInt < xc Then nInt = nInt + 1
WW1:
    Next i
    If nInt = 0 Or nInt = 2 Or nInt = 4 Or nInt = 6 Or nInt = 8 Or nInt = 10 Or nInt = 12 Then
        PointInsideContour = 0
    Else
        PointInsideContour = 1
    End If
    Exit Function
ErrorHandler:
'    MsgBox ("Error PointInsideContour")
'    MsgBox Err.Msg

End Function

' Selects the graphic and fills some structures by the data of selected graphic

Private Function PickObject(GrPick As Graphic, NumCont As Long) As Boolean
Dim x#, y#
Dim nV As Long, i As Long
Dim GrType As String
Dim Col As Long
Dim HeightVi#
Dim WidthVi#
Dim AppInt%
Dim Apper#
Dim xVi0#, xW0#, xVi1#, xW1#
    AppInt = objApp.Properties("Aperture")
    If AppInt < 3 Then AppInt = 3
    Vi.ScreenToView 0, 0, xVi0, 0
    Vi.ViewToWorld xVi0, 0, 0, xW0, 0, 0
    Vi.ScreenToView AppInt, 0, xVi1, 0
    Vi.ViewToWorld xVi1, 0, 0, xW1, 0, 0
    Apper = Abs(xVi1 - xVi0)
    On Error GoTo ErrorHandler
    PickObject = True

    HeightVi = Vi.ViewHeight
'    Apper = HeightVi / 100
Dim OldSnap As Long
    OldSnap = objApp.SnapModes
    objApp.SnapModes = 1
    Set PicRes = Vi.PickPoint(xClick, yClick, Apper, False, True, False, True, True, True)
    objApp.SnapModes = OldSnap
    If PicRes.Count = 0 Then
'        objApp.DisconnectEvents iConnectId '2048,4096 connect to "MouseDown" events
        Beep
'        MsgBox "Select an object for Boolean operation.", 0, "2D Boolean Operations"
        MsgBox LoadResString(123), 0, LoadResString(118)
        TryAgain = True
        PickObject = False
        Result = False
        Exit Function
    End If
    Set PicEnt = PicRes.Item(0)
    Set GrPick = PicEnt.Graphic
'    GrPick.Properties("Selected") = 1
'    Vi.Refresh
    If NumCont = 0 Then
On Error Resume Next
        FirstID = GrPick.ID
        GrFirstPenColor = GrPick.Properties("PenColor")
        GrFirstBrushColor = GrPick.Properties("BrushColor")
    End If

' if picked on the same graphic
    If NumCont = 1 Then
        If GrPick.ID = FirstID And PicRes.Count = 1 Then
            Beep
'            MsgBox "This object is already selected.", 0, "2D Boolean Operations"
            MsgBox LoadResString(124), 0, LoadResString(118)
            TryAgain = True
            PickObject = False
            Exit Function
        End If
        If GrPick.ID = FirstID And PicRes.Count > 1 Then
            Set GrPick = PicRes(1).Graphic
        End If
    End If

    GrType = GrPick.Type
'    MsgBox (GrType)
'    GrPick.Select
    If NumCont = 0 Then
        If InitSelectedNew(GrPick, Cont0, Cont0Int(), n0Int) = False Then
            PickObject = False
            Exit Function
        End If
    End If
    If NumCont = 1 Then

'*****************************************************
    hDrawing = TCWDrawingActive()
Dim hMatrFirst As Long, hMatrSecond As Long
Dim hGrFirst As Long, hGrSecond As Long
    hGrFirst = TCWGraphicAt(hDrawing, GrFirst.Index)
    hMatrFirst = GraphicGetMatrix(hGrFirst)
    hGrSecond = TCWGraphicAt(hDrawing, GrPick.Index)
    hMatrSecond = GraphicGetMatrix(hGrSecond)
    If MatrixEqual(hMatrFirst, hMatrSecond) = False Then
        DifferentWorkPlanes = True
    Else
        DifferentWorkPlanes = False
    End If
'**************************************************************

        If iActTool = 0 And GrPick.Layer.Name <> "$CONSTRUCTION" Then
            If GrPick.Type = GRAPHICTYPE Or GrPick.Type = CIRCLETYPE Or GrPick.Type = "TCW25DblLine" Then
'            If GrPick.Type = CIRCLETYPE Then
Dim Matr As Matrix
Dim BBox As BoundingBox
Dim xMax#, yMax#, zMax#, xMin#, yMin#, zMin#, d(3) As Double, dMin#, ScaleFactor#
                Set BBox = GrPick.CalcBoundingBox
                xMax = BBox.Max.x
                yMax = BBox.Max.y
                zMax = BBox.Max.Z
                xMin = BBox.Min.x
                yMin = BBox.Min.y
                zMin = BBox.Min.Z
                d(0) = xMax - xMin
                d(1) = yMax - yMin
                d(2) = zMax - zMin
                dMin = 1000000000

                For i = 0 To 2
                    If d(i) > 100 * Eps And d(i) < dMin Then dMin = d(i)
                Next i
                ScaleFactor = 1 + 100 * Eps / dMin
                Set Matr = GrPick.Scale(ScaleFactor, ScaleFactor, ScaleFactor)
                Vi.Refresh
                Set Matr = Nothing
                Set BBox = Nothing
            End If
        End If
        If InitSelectedNew(GrPick, Cont1, Cont1Int(), n1Int) = False Then
            PickObject = False
            Exit Function
        End If
    End If
    If NumCont = 0 Then
        GrPick.Properties("PenColor") = QBColor(13)
        GrPick.Properties("BrushColor") = QBColor(13)
    Else
        GrPick.Properties("Selected") = 1
    End If
    Vi.Refresh
    Exit Function
ErrorHandler:
    PickObject = False
'    MsgBox ("error PickObject")
'    MsgBox Err.Msg

End Function

' Defines external point for the contour - Con in Vertex with number - i

Private Sub OutPointForAdd(Con As ContGeo, i As Long, x#, y#)
On Error GoTo ErrorHandler

Dim xi#, yi#, xi1#, yi1#
    xi = Con.xVer(i)
    yi = Con.yVer(i)
    If Abs(Con.yVer(i) - Con.yVer(i + 1)) > Eps Then
        If i = Con.NVer - 1 Then
            xi1 = Con.xVer(1)
            yi1 = Con.yVer(1)
        Else
            xi1 = Con.xVer(i + 1)
            yi1 = Con.yVer(i + 1)
        End If
    Else
        If i = 0 Then
            xi1 = Con.xVer(Con.NVer - 2)
            yi1 = Con.yVer(Con.NVer - 2)
        Else
            xi1 = Con.xVer(i - 1)
            yi1 = Con.yVer(i - 1)
        End If
    End If
    y = yi + (yi1 - yi) * 0.1
    x = xi + 0.5
    Exit Sub
ErrorHandler:
'    MsgBox ("Error OutPointForAdd")
'    MsgBox Err.Msg

End Sub

' Subrotine for logical operation - SUBTRACT

Private Sub Subtract(Con0 As ContGeo, Con1 As ContGeo, NumContSubtr As Long, ContInter() As ContGeo, x#, y#, IntP As IntPoint, Result As Boolean)
On Error GoTo ErrorHandler

Dim i As Long, j As Long, k As Long
Dim xi#, yi#, xi1#, yi1#, xj#, yj#, xj1#, yj1#
Dim ai#, bi#, di#, aj#, bj#, dj#
Dim xInt#, yInt#
Dim fi#
Dim dx#, dy#, dxx#, dyy#, dl#
    Result = False
Dim sina#, cosa#, alp1#, alp2#, alp#
Dim iInt As Long, jInt As Long

'    Call TwoContInter(Con0, Con1, IntP)
    For i = 0 To IntP.nInt
        If IntP.Pr(i) = True Then GoTo EEE
        xInt = IntP.xInt(i)
        yInt = IntP.yInt(i)
        iInt = IntP.iInt(i)
        jInt = IntP.jInt(i)
        xi = Con0.xVer(iInt)
        yi = Con0.yVer(iInt)
        xi1 = Con0.xVer(iInt + 1)
        yi1 = Con0.yVer(iInt + 1)
        dx = xi1 - xi
        dy = yi1 - yi
        dl = Sqr(dx * dx + dy * dy)
        If dl < Eps Then GoTo EEE
        sina = dy / dl
        cosa = dx / dl
        alp1 = Angle(sina, cosa)

        xj = Con1.xVer(jInt)
        yj = Con1.yVer(jInt)
        xj1 = Con1.xVer(jInt + 1)
        yj1 = Con1.yVer(jInt + 1)

        dx = xj1 - xj
        dy = yj1 - yj
        dl = Sqr(dx * dx + dy * dy)
        If dl < Eps Then GoTo EEE

        sina = dy / dl
        cosa = dx / dl
        alp2 = Angle(sina, cosa)

If Abs(alp1 - alp2) < 0.1 Or Abs(Abs(alp1 - alp2) - Pi) < 0.1 Or Abs(Abs(alp1 - alp2) - 2 * Pi) < 0.1 Then GoTo EEE1
        alp = (alp1 + alp2) / 2
        For j = 0 To 3
            x = xInt + 1000 * Eps * Cos(alp + j * Pi / 2)
            y = yInt + 1000 * Eps * Sin(alp + j * Pi / 2)
            If PointInsideContouri(Con0, x, y) = 1 And PointIntoContouri(Con1, x, y) = 0 Then
                For k = 0 To NumContSubtr
                    If PointIntoContouri(ContInter(k), x, y) = 1 Then GoTo UU
                Next k
                If Abs(alp + j * Pi * 2) < 0.1 Or Abs(alp + j * Pi * 2 - Pi) < 0.1 Or Abs(alp + j * Pi * 2 - 2 * Pi) < 0.1 Then
                    If alp + j * Pi * 2 > 0 Or alp + j * Pi * 2 - Pi > 0 Or alp + j * Pi * 2 - 2 * Pi > 0 Then
                        alp = alp + j * Pi / 2 + 0.05
                    Else
                        alp = alp + j * Pi / 2 - 0.05
                    End If

                    x = xInt + 1000 * Eps * Cos(alp)
                    y = yInt + 1000 * Eps * Sin(alp)
                End If
                IntP.Pr(i) = True
                Result = True
                Exit Sub
            End If
UU:
        Next j
EEE:
    Next i
Exit Sub
EEE1:
    For i = 0 To Con0.NVer - 2
        xi = Con0.xVer(i)
        yi = Con0.yVer(i)
        xi1 = Con0.xVer(i + 1)
        yi1 = Con0.yVer(i + 1)
        dx = xi1 - xi
        dy = yi1 - yi
        dl = Sqr(dx * dx + dy * dy)
        If Abs(dl) < Eps Then GoTo S21
        If Abs(dy / dl) < 0.1 Then GoTo S21
        If Abs(dy / dl) > 0.9 Then GoTo S21
        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 + 100 * Eps
        Else
            x = (xi1 + xi) / 2 + 100 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointIntoContouri(Con1, x, y) = 0 Then
            For k = 0 To NumContSubtr
                If PointIntoContouri(ContInter(k), x, y) = 1 Then GoTo S11
            Next k
            Result = True
            Exit Sub
        End If
S11:
        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 - 100 * Eps
        Else
            x = (xi1 + xi) / 2 - 100 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointIntoContouri(Con1, x, y) = 0 Then
            For k = 0 To NumContSubtr
                If PointIntoContouri(ContInter(k), x, y) = 1 Then GoTo S21
            Next k
            Result = True
            Exit Sub
        End If
S21:
    Next i

    For i = 0 To Con1.NVer - 2
        xi = Con1.xVer(i)
        yi = Con1.yVer(i)
        xi1 = Con1.xVer(i + 1)
        yi1 = Con1.yVer(i + 1)
        dx = xi1 - xi
        dy = yi1 - yi
        dl = Sqr(dx * dx + dy * dy)
        If Abs(dl) < Eps Then GoTo S2
        If Abs(dy / dl) < 0.1 Then GoTo S2
        If Abs(dy / dl) > 0.9 Then GoTo S2
        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 + 100 * Eps
        Else
            x = (xi1 + xi) / 2 + 100 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointIntoContouri(Con1, x, y) = 0 Then
            For k = 0 To NumContSubtr
                If PointIntoContouri(ContInter(k), x, y) = 1 Then GoTo S1
            Next k
            Result = True
            Exit Sub
        End If
S1:
        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 - 100 * Eps
        Else
            x = (xi1 + xi) / 2 - 100 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointIntoContouri(Con1, x, y) = 0 Then
            For k = 0 To NumContSubtr
                If PointIntoContouri(ContInter(k), x, y) = 1 Then GoTo S2
            Next k
            Result = True
            Exit Sub
        End If
S2:
    Next i

    Exit Sub

ErrorHandler:
'    MsgBox ("Error Subtract")
'    MsgBox Err.Msg

End Sub

Private Sub AddInternal(ContExt As ContGeo, NumContAdd As Long, ContAdd() As ContGeo, x#, y#, Result As Boolean)
On Error GoTo ErrorHandler

Dim i As Long, j As Long, k As Long
Dim xi#, yi#, xi1#, yi1#, xj#, yj#, xj1#, yj1#
Dim ai#, bi#, di#, aj#, bj#, dj#
Dim xInt#, yInt#
Dim fi#
Dim l#, cosa#, sina#, xLocj#, yLocj#, xLocj1#, yLocj1#

    Result = False
    For i = 0 To Cont0.NVer - 2
        xi = Cont0.xVer(i)
        yi = Cont0.yVer(i)
        xi1 = Cont0.xVer(i + 1)
        yi1 = Cont0.yVer(i + 1)
        If Abs(xi - xi1) < Eps And Abs(yi - yi1) < Eps Then GoTo LLLL1
        ai = -(yi1 - yi)
        bi = xi1 - xi
        di = ai * xi + bi * yi
        l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
        If l < Eps Then GoTo LLLL1
        cosa = (xi1 - xi) / l
        sina = (yi1 - yi) / l
        For j = 0 To Cont1.NVer - 2
            xj = Cont1.xVer(j)
            yj = Cont1.yVer(j)
            xj1 = Cont1.xVer(j + 1)
            yj1 = Cont1.yVer(j + 1)
            If Abs(xj - xj1) < Eps And Abs(yj - yj1) < Eps Then GoTo U12

'**************************************************************************
            yLocj = (yj - yi) * cosa - (xj - xi) * sina
            xLocj = (yj - yi) * sina + (xj - xi) * cosa
            yLocj1 = (yj1 - yi) * cosa - (xj1 - xi) * sina
            xLocj1 = (yj1 - yi) * sina + (xj1 - xi) * cosa
            If yLocj > 10 * Eps And yLocj1 > 10 * Eps Then GoTo U12
            If yLocj < -10 * Eps And yLocj1 < -10 * Eps Then GoTo U12
            If Abs(yLocj - yLocj1) < 10 * Eps Then GoTo U12
            If xLocj - l > 10 * Eps And xLocj1 - l > 10 * Eps Then GoTo U12
            If xLocj < -10 * Eps And xLocj1 < -10 * Eps Then GoTo U12
            aj = -(yj1 - yj)
            bj = xj1 - xj
            dj = aj * xj + bj * yj

'***********************************************************************

            Call SysLine(ai, bi, di, aj, bj, dj, xInt, yInt)
            If PointIntoSegmenti(xi1, yi1, xi, yi, xInt, yInt) = 1 And PointIntoSegmenti(xj1, yj1, xj, yj, xInt, yInt) = 1 Then
                If PointInsideContouri(ContExt, xInt, yInt) = 1 Then

                    For k = 0 To NumContAdd
                        If PointIntoContouri(ContAdd(k), xInt, yInt) = 1 Then GoTo U12
                    Next k
                    For fi = 0.5 To 2 * Pi + 0.5 Step 2 * Pi / 35
                        x = xInt + 1000 * Eps * Cos(fi)
                        y = yInt + 1000 * Eps * Sin(fi)
                        If PointInsideContouri(Cont0, x, y) = 0 And PointIntoContouri(Cont1, x, y) = 0 Then
                            Result = True
                            Exit Sub
                        End If
                    Next fi
                    For fi = 0.5 To 2 * Pi + 0.5 Step 2 * Pi / 100
                        x = xInt + 1000 * Eps * Cos(fi)
                        y = yInt + 1000 * Eps * Sin(fi)
                        If PointInsideContouri(Cont0, x, y) = 0 And PointIntoContouri(Cont1, x, y) = 0 Then
                            Result = True
                            Exit Sub
                        End If
                    Next fi
                End If
            End If
U12:
        Next j
LLLL1:
    Next i
    Exit Sub
ErrorHandler:
'    MsgBox ("Error  AddInternal")
'    MsgBox Err.Msg

End Sub

'Define disposition contours one to other - Internal,External,Intersected,NonIntersected
'Two contours are intersected if is intersected any two segments of both contours

Private Function Location(Con0 As ContGeo, Con1 As ContGeo) As String
On Error GoTo ErrorHandler

Dim i As Long, j As Long
Dim xi#, yi#, xi1#, yi1#, xj#, yj#, xj1#, yj1#
Dim ai#, bi#, di#, aj#, bj#, dj#
Dim xInt#, yInt#
Dim l#, cosa#, sina#, xLocj#, yLocj#, xLocj1#, yLocj1#
'        l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
'        cosa = (xi1 - xi) / l
'        sina = (yi1 - yi) / l
'**************************************************************************
'            yLocj = (yj - yi) * cosa - (xj - xi) * sina
'            xLocj = (yj - yi) * sina + (xj - xi) * cosa
'            yLocj1 = (yj1 - yi) * cosa - (xj1 - xi) * sina
'            xLocj1 = (yj1 - yi) * sina + (xj1 - xi) * cosa
'            If yLocj > Eps And yLocj1 > Eps Then GoTo U12
'            If yLocj < -Eps And yLocj1 < -Eps Then GoTo U12
'            If Abs(yLocj - yLocj1) < Eps Then GoTo U12
'            If xLocj - l > Eps And xLocj1 - l > Eps Then GoTo U12
'            If xLocj < -Eps And xLocj1 < -Eps Then GoTo U12
'            aj = -(yj1 - yj)
'            bj = xj1 - xj
'            dj = aj * xj + bj * yj

'***********************************************************************

    Location = "NonIntersect"
    For i = 0 To Con0.NVer - 2
        xi = Con0.xVer(i)
        yi = Con0.yVer(i)
        xi1 = Con0.xVer(i + 1)
        yi1 = Con0.yVer(i + 1)
        If Abs(xi - xi1) < Eps And Abs(yi - yi1) < Eps Then GoTo L1
        ai = -(yi1 - yi)
        bi = xi1 - xi
        di = ai * xi + bi * yi
        l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
        cosa = (xi1 - xi) / l
        sina = (yi1 - yi) / l

        For j = 0 To Con1.NVer - 2
            xj = Con1.xVer(j)
            yj = Con1.yVer(j)
            xj1 = Con1.xVer(j + 1)
            yj1 = Con1.yVer(j + 1)
            If Abs(xj - xj1) < Eps And Abs(yj - yj1) < Eps Then GoTo U12
'**************************************************************************
            yLocj = (yj - yi) * cosa - (xj - xi) * sina
            xLocj = (yj - yi) * sina + (xj - xi) * cosa
            yLocj1 = (yj1 - yi) * cosa - (xj1 - xi) * sina
            xLocj1 = (yj1 - yi) * sina + (xj1 - xi) * cosa
            If yLocj > 10 * Eps And yLocj1 > 10 * Eps Then GoTo U12
            If yLocj < -10 * Eps And yLocj1 < -10 * Eps Then GoTo U12
            If Abs(yLocj - yLocj1) < 10 * Eps Then GoTo U12
            If xLocj - l > 10 * Eps And xLocj1 - l > 10 * Eps Then GoTo U12
            If xLocj < -10 * Eps And xLocj1 < -10 * Eps Then GoTo U12
            aj = -(yj1 - yj)
            bj = xj1 - xj
            dj = aj * xj + bj * yj

'***********************************************************************

            Call SysLine(ai, bi, di, aj, bj, dj, xInt, yInt)
            If PointIntoSegmenti(xi1, yi1, xi, yi, xInt, yInt) = 1 And PointIntoSegmenti(xj1, yj1, xj, yj, xInt, yInt) = 1 Then
                Location = "Intersect"
                Exit Function
            End If
U12:
        Next j
L1:
    Next i

U3:
' if contours are not intersected, define interlocation - Internal,External
    xi = Con0.xVer(0)
    yi = Con0.yVer(0)
    If PointIntoContouri(Con1, xi, yi) = 1 Then
        Location = "Internal"
' First contour is internal to second one
        Exit Function
    End If
    xj = Con1.xVer(0)
    yj = Con1.yVer(0)
    If PointIntoContouri(Con0, xj, yj) = 1 Then
        Location = "External"
' Second contour is internal to first one.
        Exit Function
    End If
    Location = "NonIntersect"
    Exit Function
ErrorHandler:
 '   MsgBox ("Error Location")
 '   MsgBox Err.Msg
    Location = "Error"
End Function

Private Sub PointIntersectionTwoContours(Con0 As ContGeo, Con1 As ContGeo, x#, y#)
On Error GoTo ErrorHandler
Dim l#, cosa#, sina#, xLocj#, yLocj#, xLocj1#, yLocj1#

Dim i As Long, j As Long, k As Long
Dim xi#, yi#, xi1#, yi1#, xj#, yj#, xj1#, yj1#
Dim ai#, bi#, di#, aj#, bj#, dj#
Dim xInt#, yInt#
Dim fi#

    x = -1000000
    y = -1000000
    For i = 0 To Con0.NVer - 2
        xi = Con0.xVer(i)
        yi = Con0.yVer(i)
        xi1 = Con0.xVer(i + 1)
        yi1 = Con0.yVer(i + 1)
        If Abs(xi - xi1) < Eps And Abs(yi - yi1) < Eps Then GoTo LLLL1

        ai = -(yi1 - yi)
        bi = xi1 - xi
        di = ai * xi + bi * yi
        l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
        cosa = (xi1 - xi) / l
        sina = (yi1 - yi) / l

        For j = 0 To Con1.NVer - 2
            xj = Con1.xVer(j)
            yj = Con1.yVer(j)
            xj1 = Con1.xVer(j + 1)
            yj1 = Con1.yVer(j + 1)
            If Abs(xj - xj1) < Eps And Abs(yj - yj1) < Eps Then GoTo U12

'**************************************************************************
            yLocj = (yj - yi) * cosa - (xj - xi) * sina
            xLocj = (yj - yi) * sina + (xj - xi) * cosa
            yLocj1 = (yj1 - yi) * cosa - (xj1 - xi) * sina
            xLocj1 = (yj1 - yi) * sina + (xj1 - xi) * cosa
            If yLocj > 10 * Eps And yLocj1 > 10 * Eps Then GoTo U12
            If yLocj < -10 * Eps And yLocj1 < -10 * Eps Then GoTo U12
            If Abs(yLocj - yLocj1) < 10 * Eps Then GoTo U12
            If xLocj - l > 10 * Eps And xLocj1 - l > 10 * Eps Then GoTo U12
            If xLocj < -10 * Eps And xLocj1 < -10 * Eps Then GoTo U12
            aj = -(yj1 - yj)
            bj = xj1 - xj
            dj = aj * xj + bj * yj

'***********************************************************************

            Call SysLine(ai, bi, di, aj, bj, dj, xInt, yInt)
            If PointIntoSegmenti(xi1, yi1, xi, yi, xInt, yInt) = 1 And PointIntoSegmenti(xj1, yj1, xj, yj, xInt, yInt) = 1 Then
                x = xInt
                y = yInt
                Exit Sub
            End If
U12:
        Next j
LLLL1:
    Next i
    Exit Sub
ErrorHandler:
'    MsgBox ("Error PointIntersectionTwoContours")
'    MsgBox Err.Msg

End Sub

'define extreme right point fo both contours
Private Sub LeftPointTwoGrap(Con0 As ContGeo, Con1 As ContGeo, x#, y#)
On Error GoTo ErrorHandler

' Define xMax, xMin for both contours
Dim i As Long
Dim xMaxFirst#, xMinFirst#, xMaxSecond#, xMinSecond#
Dim iXmaxFirst As Long, iXminFirst As Long, iXmaxSecond As Long, iXminSecond As Long
Dim yMaxFirst#, yMinFirst#, yMaxSecond#, yMinSecond#

    xMaxFirst = -1000000
    xMinFirst = 1000000
    xMaxSecond = -1000000
    xMinSecond = 1000000
    For i = 0 To Con0.NVer - 2
        If Con0.xVer(i) > xMaxFirst Then
            xMaxFirst = Con0.xVer(i)
            iXmaxFirst = i
        End If
        If Con0.xVer(i) < xMinFirst Then
            xMinFirst = Con0.xVer(i)
            iXminFirst = i
        End If
    Next i
    For i = 0 To Con1.NVer - 2
        If Con1.xVer(i) > xMaxSecond Then
            xMaxSecond = Con1.xVer(i)
            iXmaxSecond = i
        End If
        If Con1.xVer(i) < xMinSecond Then
            xMinSecond = Con1.xVer(i)
            iXminSecond = i
        End If
    Next i
    yMaxFirst = -1000000
    yMinFirst = 1000000
    yMaxSecond = -1000000
    yMinSecond = 1000000
    For i = 0 To Con0.NVer - 2
        If Con0.yVer(i) > yMaxFirst Then
            yMaxFirst = Con0.yVer(i)
        End If
        If Con0.yVer(i) < yMinFirst Then
            yMinFirst = Con0.yVer(i)
        End If
    Next i
    For i = 0 To Con1.NVer - 2
        If Con1.yVer(i) > yMaxSecond Then
            yMaxSecond = Con1.yVer(i)
        End If
        If Con1.yVer(i) < yMinSecond Then
            yMinSecond = Con1.yVer(i)
        End If
    Next i
    If xMaxFirst > xMaxSecond Then
        Call OutPointForAdd(Con0, iXmaxFirst, x#, y#)
    Else
        Call OutPointForAdd(Con1, iXmaxSecond, x#, y#)
    End If
    Exit Sub

ErrorHandler:
'    MsgBox ("Error LeftPointTwoGrap")
'    MsgBox Err.Msg

End Sub

' Function return True if two contours are intersected
' and return False if Two contouts are not intersected

Private Function TwoContInter(Con0 As ContGeo, Con1 As ContGeo, IntP As IntPoint) As Boolean
On Error GoTo ErrorHandler
Dim l#, cosa#, sina#, xLocj#, yLocj#, xLocj1#, yLocj1#

Dim i As Long, j As Long, k As Long
Dim xi#, yi#, xi1#, yi1#, xj#, yj#, xj1#, yj1#
Dim ai#, bi#, di#, aj#, bj#, dj#
Dim xInt#, yInt#
Dim fi#
    k = -1
    TwoContInter = False
    For i = 0 To Con0.NVer - 2
        xi = Con0.xVer(i)
        yi = Con0.yVer(i)
        xi1 = Con0.xVer(i + 1)
        yi1 = Con0.yVer(i + 1)
        If Abs(xi - xi1) < Eps And Abs(yi - yi1) < Eps Then GoTo LLLL1

        ai = -(yi1 - yi)
        bi = xi1 - xi
        di = ai * xi + bi * yi
        l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
        cosa = (xi1 - xi) / l
        sina = (yi1 - yi) / l

        For j = 0 To Con1.NVer - 2
            xj = Con1.xVer(j)
            yj = Con1.yVer(j)
            xj1 = Con1.xVer(j + 1)
            yj1 = Con1.yVer(j + 1)
            If Abs(xj - xj1) < Eps And Abs(yj - yj1) < Eps Then GoTo U12

            aj = -(yj1 - yj)
            bj = xj1 - xj
            dj = aj * xj + bj * yj
'**************************************************************************
            yLocj = (yj - yi) * cosa - (xj - xi) * sina
            xLocj = (yj - yi) * sina + (xj - xi) * cosa
            yLocj1 = (yj1 - yi) * cosa - (xj1 - xi) * sina
            xLocj1 = (yj1 - yi) * sina + (xj1 - xi) * cosa
            If yLocj > 10 * Eps And yLocj1 > 10 * Eps Then GoTo U12
            If yLocj < -10 * Eps And yLocj1 < -10 * Eps Then GoTo U12
            If Abs(yLocj - yLocj1) < 10 * Eps Then GoTo U12
            If xLocj - l > 10 * Eps And xLocj1 - l > 10 * Eps Then GoTo U12
            If xLocj < -10 * Eps And xLocj1 < -10 * Eps Then GoTo U12
            aj = -(yj1 - yj)
            bj = xj1 - xj
            dj = aj * xj + bj * yj

'***********************************************************************

            Call SysLine(ai, bi, di, aj, bj, dj, xInt, yInt)
            If PointIntoSegmenti(xi1, yi1, xi, yi, xInt, yInt) = 1 And PointIntoSegmenti(xj1, yj1, xj, yj, xInt, yInt) = 1 Then
                TwoContInter = True
                k = k + 1
                IntP.xInt(k) = xInt
                IntP.yInt(k) = yInt
                IntP.iInt(k) = i
                IntP.jInt(k) = j
                IntP.Pr(k) = False
'MsgBox ("TwoPointinter  k=" & CStr(k) & "  xInt=" & CStr(xInt) & " yInt=" & CStr(yInt))
            End If
U12:
        Next j
LLLL1:
    Next i
    IntP.nInt = k
    Exit Function
ErrorHandler:
'    MsgBox ("Error TwoContInter")
'    MsgBox Err.Msg

End Function

' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
' Add all intersected internal contours for both graphics

Private Function AddAllHoles(ContInter() As ContGeo, NumContInter As Long) As Boolean
On Error GoTo ErrorHandler
Dim Result As Boolean
Dim k As Long, i As Long, j As Long, nV As Long, j1 As Long, i1 As Long, k1 As Long
Dim xInt#, yInt#, x#, y#, fi#
Dim ContCom(50) As ContGeo
Dim IntP As IntPoint
ReDim IntP.xInt(50)
ReDim IntP.yInt(50)
ReDim IntP.iInt(50)
ReDim IntP.jInt(50)
ReDim IntP.Pr(50)
Dim Ver As Object
Dim ContTime As ContGeo
Dim ContRes(50) As ContGeo
Dim nRes As Long
    nRes = -1
AddAllHoles = True
    For i = 0 To n0Int - 1
        Cont0Int(i).Pr = False
    Next i
    For i = 0 To n1Int - 1
        Cont1Int(i).Pr = False
    Next i

    For k = 0 To NumContInter
 ' Subtract all internal contours of the First graphic
        ContCom(0) = ContInter(k)
Dim VertexIntoContours As Boolean
Dim nG As Long
        nG = 0
Dim ContInt(50) As ContGeo
Dim nGInt As Long
        nGInt = -1
        ContCom(0).Pr = False
HOLE000:
        For i = 0 To nG
            If ContCom(i).Pr = True Then GoTo HOLE30

            For j = 0 To n0Int - 1
                If Cont0Int(j).Loc(0) = "NonIntersect" Then GoTo HOLE60
                If Cont0Int(j).Pr = True Then GoTo HOLE60
                If TwoContInter(ContCom(i), Cont0Int(j), IntP) = True Then
HOLE20:
                    For j1 = 0 To IntP.nInt
                        VertexIntoContours = False
                        xInt = IntP.xInt(j1)
                        yInt = IntP.yInt(j1)
                        For i1 = 0 To nGInt
                            If PointIntoContouri(ContInt(i1), xInt, yInt) = 1 Then
                                VertexIntoContours = True
                                GoTo HOLE40
                            End If
                        Next i1
                        If VertexIntoContours = False Then GoTo HOLE70
HOLE40:
                    Next j1
HOLE70:
                        If VertexIntoContours = False Then
                            For fi = 0.5 To 2 * Pi + 0.5 Step 2 * Pi / 30
                                x = xInt + 1000 * Eps * Cos(fi)
                                y = yInt + 1000 * Eps * Sin(fi)
                                If PointInsideContouri(ContCom(i), x, y) = 1 And PointIntoContouri(Cont0Int(j), x, y) = 0 Then GoTo HOLE50
                            Next fi
HOLE50:

                            nGInt = nGInt + 1
                            Call InitNew(ContCom(i), Cont0Int(j), 2, x, y, ContInt(nGInt))
                            GoTo HOLE20
                        End If
                    For j1 = 0 To nGInt
                        ContCom(nG + j1 + 1) = ContInt(j1)
                        ContCom(nG + j1 + 1).Pr = False
                    Next j1
                    ContCom(i).Pr = True
                    Cont0Int(j).Pr = True
                    nG = nG + nGInt + 1
                    nGInt = -1
                    GoTo HOLE000
                End If
HOLE60:
            Next j
HOLE30:
        Next i

'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
' Subtracting holes of the Secong graphic
Dim Pr As Boolean
        Pr = False

            For j = 0 To n1Int - 1
                If Cont1Int(j).Loc(0) = "NonIntersect" Then GoTo HOLE6
                If Cont1Int(j).Pr = True Then GoTo HOLE6
                For i = 0 To nG
                    If ContCom(i).Pr = True Then GoTo HOLE300
                    If TwoContInter(ContCom(i), Cont1Int(j), IntP) = True Then
HOLE2:
                        For j1 = 0 To IntP.nInt
                            VertexIntoContours = False
                            xInt = IntP.xInt(j1)
                            yInt = IntP.yInt(j1)
                            For i1 = 0 To nGInt
                                If PointIntoContouri(ContInt(i1), xInt, yInt) = 1 Then
                                    VertexIntoContours = True
                                    GoTo HOLE4
                                End If
                            Next i1
                            If VertexIntoContours = False Then GoTo HOLE7
HOLE4:
                        Next j1
HOLE7:
                        If VertexIntoContours = False Then
                            For fi = 0.5 To 2 * Pi + 0.5 Step 2 * Pi / 24
                                x = xInt + 1000 * Eps * Cos(fi)
                                y = yInt + 1000 * Eps * Sin(fi)
                                If PointInsideContouri(ContCom(i), x, y) = 1 And PointIntoContouri(Cont1Int(j), x, y) = 0 Then GoTo HOLE5
                            Next fi
HOLE5:
                            Pr = True
                            nGInt = nGInt + 1
                            Call InitNew(ContCom(i), Cont1Int(j), 2, x, y, ContInt(nGInt))
                            GoTo HOLE2
                        End If
                        For j1 = 0 To nGInt
                            ContCom(nG + j1 + 1) = ContInt(j1)
                            ContCom(nG + j1 + 1).Pr = False
                        Next j1
                        ContCom(i).Pr = True
                        nG = nG + nGInt + 1
                        nGInt = -1
                    End If
HOLE300:
                Next i
HOLE6:
                If Pr = True Then
                    Cont1Int(j).Pr = True
                    Pr = False
                End If
            Next j

        For i = 0 To nG
            If ContCom(i).Pr = False Then
                nRes = nRes + 1
                ContRes(nRes) = ContCom(i)
            End If
        Next i

        For i = 0 To n0Int - 1
            Cont0Int(i).Pr = False
        Next i
        For i = 0 To n1Int - 1
            Cont1Int(i).Pr = False
        Next i
    Next k 'End k

' Draw all internal contours in external contours  created above
Dim nInt As Long
    nInt = -1 'Internal contour's counter for internal counters which locate into
              ' resulting external contours
 'Write into ContCon(i)  internal counters which locate into resulting external contours
    For i = 0 To n0Int - 1 ' Internal contours of the First graphic
        If Cont0Int(i).Loc(0) = "NonIntersect" Or Cont0Int(i).Loc(0) = "Intersect" Then GoTo a1
        For j = 0 To nRes
            If TwoContInter(ContRes(j), Cont0Int(i), IntP) = False And PointInsideContouri(ContRes(j), Cont0Int(i).xVer(0), Cont0Int(i).yVer(0)) = 1 Then
                nInt = nInt + 1
                ContCom(nInt) = Cont0Int(i)
                ContCom(nInt).Pr = False
                GoTo a1
            End If
        Next j
a1:
    Next i
    For i = 0 To n1Int - 1 ' Internal contours of the Second graphic
        If Cont1Int(i).Loc(0) = "NonIntersect" Or Cont1Int(i).Loc(0) = "Intersect" Then GoTo A2
        For j = 0 To nRes
            If TwoContInter(ContRes(j), Cont1Int(i), IntP) = False And PointInsideContouri(ContRes(j), Cont1Int(i).xVer(0), Cont1Int(i).yVer(0)) = 1 Then
                nInt = nInt + 1
                ContCom(nInt) = Cont1Int(i)
                ContCom(nInt).Pr = False
                GoTo A2
            End If
        Next j
A2:
    Next i
 ' End writing into ContCom(i)

' Begin: Add all intersected contours
A5:
    For i = 0 To nInt
        If ContCom(i).Pr = True Then GoTo A3
        For j = i + 1 To nInt
            If ContCom(j).Pr = True Then GoTo A4
            If TwoContInter(ContCom(i), ContCom(j), IntP) = True Then
                Call LeftPointTwoGrap(ContCom(i), ContCom(j), x, y)
                Call InitNew(ContCom(i), ContCom(j), 2, x, y, ContCom(i))
                ContCom(j).Pr = True
                GoTo A5
            End If
A4:
        Next j
A3:
    Next i '  Add all intersected contours

'Dim GrGroup As Object
'Dim GrIntoGroup As Boolean
'Dim GrInd As Long
'    For i = 0 To nRes
'        GrIntoGroup = False
'        Set GrGroup = Grs.Add(11)
'        For j = 0 To nInt
'            If ContCom(j).Pr = True Then GoTo A7
'            If PointInsideContour(ContRes(i), ContCom(j).xVer(0), ContCom(j).yVer(0)) = 1 Then
'                If GrIntoGroup = False Then
'                    Set Gr = GrGroup.Graphics.Add(11)
'                    For j1 = 0 To ContRes(i).NVer - 1
'                        Set Ver = Gr.Vertices.Add(ContRes(i).xVer(j1), ContRes(i).yVer(j1), 0)
'                    Next j1
'                    GrIntoGroup = True
'                End If
'                Set Gr = GrGroup.Graphics.Add(11)
'                For j1 = 0 To ContCom(j).NVer - 1
'                    Set Ver = Gr.Vertices.Add(ContCom(j).xVer(j1), ContCom(j).yVer(j1), 0)
'                Next j1
'                ContCom(j).Pr = True
'            End If
'A7:
'        Next j
'        If GrIntoGroup = False Then
'            Set Gr = Grs.Add(11)
'            For j1 = 0 To ContRes(i).NVer - 1
'                Set Ver = Gr.Vertices.Add(ContRes(i).xVer(j1), ContRes(i).yVer(j1), 0)
'            Next j1
'        End If
'    Next i

' Draw Rresulting contours with unvisible lines

Dim nnRes As Long
Dim ResCont(100) As ContGeo
    For i = 0 To nRes
        nnRes = 0
        ResCont(nnRes) = ContRes(i)
        For j = 0 To nInt
            If ContCom(j).Pr = True Then GoTo A7
            If PointInsideContouri(ContRes(i), ContCom(j).xVer(0), ContCom(j).yVer(0)) = 1 Then
                nnRes = nnRes + 1
                ResCont(nnRes) = ContCom(j)
                ContCom(j).Pr = True
            End If
A7:
        Next j
        Call HorizontalIntersection(ResCont, nnRes, 0)
    Next i
    Exit Function

ErrorHandler:
 '   MsgBox ("Error AddAllHoles")
 '   MsgBox Err.Msg
    AddAllHoles = False
End Function

Private Function InitNew(Con0 As ContGeo, Con1 As ContGeo, NumG As Long, x#, y#, ConCom As ContGeo) As Boolean

On Error GoTo ErrHand
    InitNew = True
Dim xRes(10000) As Double
Dim yRes(10000) As Double
Dim nRes As Long
    nRes = 0

Dim Rot% ' Initial direction of going  =1 - against clockwise  = -1 - clockwise
    Rot = 1

Dim i As Long, j As Long
Dim nV As Long
Dim xMax#, xMin#, yMax#, yMin#
Dim kWork% ' Number of work contour
Dim jInit% ' Initial vertex
Dim dir%
    dir = 1
    xMax = -100000000
    xMin = 100000000
    yMax = -100000000
    yMin = 100000000

'---------------------------------------------------------------------------
Dim Con(2) As ContGeo
    Con(0) = Con0
    Con(1) = Con1

'---------------------------------------------------------------------------
'Dim Grap As Object
Dim xx#, yy#
Dim xi#, yi#, xi1#, yi1#
Dim k%
Dim k1% ' counter intersecting contours
Dim xj#, yj#, xj1#, yj1#
Dim a#, b#
Dim l#
Dim dx#, dxx#, dy#, dyy#
Dim xBeg#, yBeg#, xEnd#, yEnd#, xEnd1#, yEnd1#
'Dim Ver As Object
'Dim Props As Object
'Dim PColor As Object
Dim Pr%
    Pr = 0
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' define left nearest object to  MouseClick
    dir = 1
Dim lxMin#, dxMin#, Vers As Object, xInt#, yInt#, xintMin#, dyMin#
    dxMin = 10000000
    dyMin = 10000000
    For i = 0 To NumG - 1
        nV = Con(i).NVer
        For j = 0 To nV - 2
            xj = Con(i).xVer(j)
            yj = Con(i).yVer(j)
            xj1 = Con(i).xVer(j + 1)
            yj1 = Con(i).yVer(j + 1)
            If Abs(xj - xj1) < Eps And Abs(yj - yj1) < Eps Then GoTo LLLL1
            If Abs(yj1 - yj) > Eps Then
                xInt = xj + (xj1 - xj) / (yj1 - yj) * (y - yj)
                If PointIntoSegmenti(xj, yj, xj1, yj1, xInt, y) = 1 And x - xInt > Eps Then
                    If x - xInt < dxMin Then
                        dxMin = x - xInt
                        xintMin = xInt
                        jInit = j
                        kWork = i
                    End If
                End If
            End If
LLLL1:
        Next j
    Next i
' define Dir for initial segment clockwise
    xBeg = Con(kWork).xVer(jInit)
    yBeg = Con(kWork).yVer(jInit)
    xEnd = Con(kWork).xVer(jInit + 1)
    yEnd = Con(kWork).yVer(jInit + 1)
'MsgBox ("xBeg=" & CStr(xBeg) & " yBeg=" & CStr(yBeg) & "   xEnd=" & CStr(xEnd) & " yEnd=" & CStr(yEnd))

    If yEnd > yBeg Then
        dir = 1
    Else
        dir = -1
        jInit = jInit + 1
        xBeg = Con(kWork).xVer(jInit)
        yBeg = Con(kWork).yVer(jInit)
        xEnd = Con(kWork).xVer(jInit + dir)
        yEnd = Con(kWork).yVer(jInit + dir)
    End If
' Define initial point of inital segment
Dim a1#, b1#, d1#, aj#, bj#, dj#
Dim cosa#, sina#, xLocj#, yLocj#, xLocj1#, yLocj1#
Dim lt#

    a1 = -(yEnd - yBeg)
    b1 = xEnd - xBeg
    d1 = a1 * xBeg + b1 * yBeg
    lt = Sqr((xEnd - xBeg) * (xEnd - xBeg) + (yEnd - yBeg) * (yEnd - yBeg))
    If lt < Eps Then GoTo GGG1
    cosa = (xEnd - xBeg) / lt
    sina = (yEnd - yBeg) / lt
    k1 = 0
    For k = 0 To NumG - 1
        If k = kWork Then GoTo LL
        For j = 0 To Con(k).NVer - 2
            xj = Con(k).xVer(j)
            yj = Con(k).yVer(j)
            xj1 = Con(k).xVer(j + 1)
            yj1 = Con(k).yVer(j + 1)
            If Abs(xj - xj1) < Eps And Abs(yj - yj1) < Eps Then GoTo LLL
            aj = -(yj1 - yj)
            bj = xj1 - xj
            dj = aj * xj + bj * yj
'New&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
            yLocj = (yj - yBeg) * cosa - (xj - xBeg) * sina
            xLocj = (yj - yBeg) * sina + (xj - xBeg) * cosa
            yLocj1 = (yj1 - yBeg) * cosa - (xj1 - xBeg) * sina
            xLocj1 = (yj1 - yBeg) * sina + (xj1 - xBeg) * cosa
            If yLocj > 1 * Eps And yLocj1 > 1 * Eps Then GoTo LLL
            If yLocj < -1 * Eps And yLocj1 < -1 * Eps Then GoTo LLL
            If Abs(yLocj - yLocj1) < 10 * Eps Then GoTo LLL
            If xLocj - lt > 1 * Eps And xLocj1 - lt > 1 * Eps Then GoTo LLL
            If xLocj < -1 * Eps And xLocj1 < -1 * Eps Then GoTo LLL

'New&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
            Call SysLine(a1, b1, d1, aj, bj, dj, xInt, yInt)
            If PointIntoSegmentiInter(xBeg, yBeg, xEnd, yEnd, xInt, yInt) = 1 And PointIntoSegmentjInter(xj, yj, xj1, yj1, xInt, yInt) = 1 Then
                l = Sqr((xInt - xBeg) * (xInt - xBeg) + (yInt - yBeg) * (yInt - yBeg))
                Dist(k1).LL = l
                Dist(k1).xx = xInt
                Dist(k1).yy = yInt
'Set Gr = Grs.AddCross(xInt, yInt, 0)
'Vi.Refresh
'MsgBox ("BegInt k1=" & CStr(k1))
                k1 = k1 + 1
            End If
LLL:
        Next j
LL:
    Next k
Dim lMin#, l0#
Dim imin%
Dim pr0%, pp%
    pr0 = 0
    pp = 0
    lMin = 10000000
    l0 = Sqr((xintMin - xBeg) * (xintMin - xBeg) + (y - yBeg) * (y - yBeg))
    For i = 0 To k1 - 1
        xInt = Dist(i).xx
        yInt = Dist(i).yy
        If PointIntoSegmenti(xBeg, yBeg, xintMin, y, xInt, yInt) = 1 Then
            l = l0 - Dist(i).LL
            If l < lMin Then
                lMin = l
                imin = i
                pp = 1
            End If
        End If
    Next i
    If k1 > 0 And pp = 1 Then
        xBeg = Dist(imin).xx
        yBeg = Dist(imin).yy
        l0 = lMin
        pr0 = 1
    End If
GGG1:
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' Initial point of result contour
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'Set Gr = Grs.AddCircle(xBeg, yBeg, 0)
'Vi.Refresh
'MsgBox ("Initial Point")
'Gr.Delete
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
    xRes(nRes) = xBeg
    yRes(nRes) = yBeg
    nRes = nRes + 1
'MsgBox ("xBeg=" & CStr(xBeg) & " yBeg=" & CStr(yBeg))
LBEG:
    If dir = -1 And jInit = 0 Then jInit = Con(kWork).NVer - 1
    If dir = 1 And jInit = Con(kWork).NVer - 1 Then jInit = 0
    If Pr = 0 Then
        xi = xBeg
        yi = yBeg
    Else
        xi = Con(kWork).xVer(jInit)
        yi = Con(kWork).yVer(jInit)
    End If
    If Pr <> 0 Then
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'Set Gr = Grs.AddCircle(xi, yi, 0)
'Vi.Refresh
'MsgBox ("111Init")
'Gr.Delete

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
        xRes(nRes) = xi
        yRes(nRes) = yi
        nRes = nRes + 1
    End If
    If nRes > 5000 Then
        InitNew = False
        Exit Function
    End If
    xi1 = Con(kWork).xVer(jInit + dir)
    yi1 = Con(kWork).yVer(jInit + dir)
    If Abs(xi - xBeg) < Eps And Abs(yi - yBeg) < Eps And Pr <> 0 Then
        GoTo EndInit
    End If
    Pr = 1

' Defining the number of contours intersecting with curent segment
LBEG1:
    k1 = 0
    a1 = -(yi1 - yi)
    b1 = xi1 - xi
    d1 = a1 * xi + b1 * yi
    lt = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
    If lt < Eps Then GoTo LLLL
    cosa = (xi1 - xi) / lt
    sina = (yi1 - yi) / lt

    For k = 0 To NumG - 1
        If k = kWork Then GoTo L1
        For j = 0 To Con(k).NVer - 2
            xj = Con(k).xVer(j)
            yj = Con(k).yVer(j)
            xj1 = Con(k).xVer(j + 1)
            yj1 = Con(k).yVer(j + 1)
            If Abs(xj - xj1) < Eps And Abs(yj - yj1) < Eps Then GoTo L4
            If Abs(xj - xj1) < Eps And Abs(yj - yj1) < Eps Then GoTo L4
            aj = -(yj1 - yj)
            bj = xj1 - xj
            dj = aj * xj + bj * yj
'New&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
            yLocj = (yj - yi) * cosa - (xj - xi) * sina
            xLocj = (yj - yi) * sina + (xj - xi) * cosa
            yLocj1 = (yj1 - yi) * cosa - (xj1 - xi) * sina
            xLocj1 = (yj1 - yi) * sina + (xj1 - xi) * cosa
            If yLocj > 1 * Eps And yLocj1 > 1 * Eps Then GoTo L4
            If yLocj < -1 * Eps And yLocj1 < -1 * Eps Then GoTo L4
            If Abs(yLocj - yLocj1) < Eps And Abs(yLocj) > 10 * Eps Then GoTo L4
            If xLocj - lt > 10 * Eps And xLocj1 - lt > 10 * Eps Then GoTo L4
            If xLocj < -10 * Eps And xLocj1 < -10 * Eps Then GoTo L4

'New&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

' If two lines are coincident
            If Abs(yLocj) < Eps And Abs(yLocj1) < Eps Then
         ' If work segment is inside other segment
                If xLocj < Eps And xLocj1 - lt > 10 * Eps And k <> kWork Then
                    jInit = j
                    dir = 1
                    xi1 = xj1
                    yi1 = yj1
                    kWork = k
                    GoTo LBEG1
                End If
                If xLocj1 < Eps And xLocj - lt > 10 * Eps And k <> kWork Then
                    jInit = j + 1
                    dir = -1
                    xi1 = xj
                    yi1 = yj
                    kWork = k
                    GoTo LBEG1
                End If

        ' If Work segment and other segment coincident in ended points
                If Abs(xLocj - lt) < Eps And xLocj1 - lt > 10 * Eps Then
                    Dist(k1).LL = lt
                    Dist(k1).xx = xi1
                    Dist(k1).yy = yi1
                    Dist(k1).jj = j
                    Dist(k1).jj1 = j + 1
                    Dist(k1).kk = k
                    k1 = k1 + 1 'Set Gr = Grs.AddCross(xint, yint, 0)
                    GoTo L4
                End If
                If Abs(xLocj1 - lt) < Eps And xLocj - lt > 10 * Eps Then
                    Dist(k1).LL = lt
                    Dist(k1).xx = xi1
                    Dist(k1).yy = yi1
                    Dist(k1).jj = j
                    Dist(k1).jj1 = j + 1
                    Dist(k1).kk = k
                    k1 = k1 + 1 'Set Gr = Grs.AddCross(xint, yint, 0)
                    GoTo L4
                End If

            End If

            If Abs(yLocj) < Eps And Abs(yLocj1) < Eps Then GoTo L4
'MsgBox ("Befor SysLine xi=" & CStr(xi) & " yi=" & CStr(yi))
            Call SysLine(a1, b1, d1, aj, bj, dj, xInt, yInt)
            If PointIntoSegmentiInter(xi, yi, xi1, yi1, xInt, yInt) = 1 And PointIntoSegmentjInter(xj, yj, xj1, yj1, xInt, yInt) = 1 Then
                l = Sqr((xInt - xi) * (xInt - xi) + (yInt - yi) * (yInt - yi))
                Dist(k1).LL = l
                Dist(k1).xx = xInt
                Dist(k1).yy = yInt
                Dist(k1).jj = j
                Dist(k1).jj1 = j + 1
                Dist(k1).kk = k
                k1 = k1 + 1
'MsgBox ("xi=" & CStr(xi) & " yi=" & CStr(yi) & "   xi1=" & CStr(xi1) & " yi1=" & CStr(yi1) & " xInt=" & CStr(xInt) & " yInt=" & CStr(yInt))

            End If
L4:
        Next j
L1:
    Next k
LLLL:
Dim alfaj#, alfai#
Dim jj%, kk%, pr1%, pr2%, prr%
    pr1 = 0
    pr2 = 0
    prr = 0
'There ara not intersections with segment
    If k1 = 0 Then
'checking intersection contour- kWork with other contouts in point - i+1
Dim xii#, yii#
Dim yLoc#, xLoc#
Dim jj1%
Dim xxi1#, yyi1#
Dim alfaj1#
        If dir = 1 And jInit = Con(kWork).NVer - 1 Then
            jInit = 0
        End If
        If dir = -1 And jInit = 0 Then
            jInit = Con(kWork).NVer - 1
        End If

        jInit = jInit + dir
        If dir = 1 And jInit = Con(kWork).NVer - 1 Then
            jInit = 0
        End If
        If dir = -1 And jInit = 0 Then
            jInit = Con(kWork).NVer - 1
        End If

        GoTo LBEG
    End If   ' k1=0
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' if k1>0 There are same intersections current segment witt other graphics
Dim kmin%
    lMin = 10000000
    For k = 0 To k1 - 1
        If lMin > Dist(k).LL Then
            lMin = Dist(k).LL
            kmin = k
        End If
    Next k
Dim k2%, Mi(10) As Long
    k2 = 0
' Define number graphics intersecting with current segment at nearest point
    For k = 0 To k1 - 1
        If Abs(Dist(k).LL - lMin) < 10 * Eps Then
            Mi(k2) = k
            k2 = k2 + 1
        End If
    Next k
    l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
    cosa = (xi1 - xi) / l
    sina = (yi1 - yi) / l
Dim j1%
 ' There are intersections current segment with oter graphics
 Dim xinter#, yinter#, beta1#, beta2#, xj_1#, yj_1#
    For k = 0 To k2 - 1
        xinter = Dist(Mi(k)).xx
        yinter = Dist(Mi(k)).yy
        j = Dist(Mi(k)).jj
        k1 = Dist(Mi(k)).kk
        xj = Con(k1).xVer(j)
        yj = Con(k1).yVer(j)
        xj1 = Con(k1).xVer(j + 1)
        yj1 = Con(k1).yVer(j + 1)
        ' If point of intersection concidences with vertex - j
        If Abs(xinter - xj) < Eps And Abs(yinter - yj) < Eps Then
            If j = 0 Then
                beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj1, yj1)
                xj_1 = Con(k1).xVer(Con(k1).NVer - 2)
                yj_1 = Con(k1).yVer(Con(k1).NVer - 2)
                beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                BetaMin(k).Bet = beta1
                BetaMin(k).kk = k1
                BetaMin(k).jInit = j
                BetaMin(k).ddir = 1
            Else
                beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj1, yj1)
                xj_1 = Con(k1).xVer(j - 1)
                yj_1 = Con(k1).yVer(j - 1)
                beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                If beta1 > beta2 Then
                    BetaMin(k).Bet = beta2
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j
                    BetaMin(k).ddir = -1
                Else
                    BetaMin(k).Bet = beta1
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j
                    BetaMin(k).ddir = 1
                End If
            End If
            GoTo GGG
        End If
        ' If point of intersection concidences with vertex - j+1
        If Abs(xinter - xj1) < Eps And Abs(yinter - yj1) < Eps Then
            If j + 1 = Con(k1).NVer - 1 Then
                beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
                xj_1 = Con(k1).xVer(1)
                yj_1 = Con(k1).yVer(1)
                beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                If beta1 > beta2 Then
                    BetaMin(k).Bet = beta2
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = 0
                    BetaMin(k).ddir = 1
                Else
                    BetaMin(k).Bet = beta1
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j + 1
                    BetaMin(k).ddir = -1
                End If
            Else
                beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
                xj_1 = Con(k1).xVer(j + 2)
                yj_1 = Con(k1).yVer(j + 2)
                beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                BetaMin(k).Bet = beta1
                BetaMin(k).kk = k1
                BetaMin(k).jInit = j + 1
                BetaMin(k).ddir = -1
            End If
            GoTo GGG
        End If
        ' If point of intersection is internal point of segment j - j+1
        beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
        beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj1, yj1)
        If beta1 > beta2 Then
            BetaMin(k).Bet = beta2
            BetaMin(k).kk = k1
            BetaMin(k).jInit = j
            BetaMin(k).ddir = 1
        Else
            BetaMin(k).Bet = beta1
            BetaMin(k).kk = k1
            BetaMin(k).jInit = j + 1
            BetaMin(k).ddir = -1
        End If
GGG:
        ' Conditions for current graphic -kWork
        If Abs(xinter - xi1) < Eps And Abs(yinter - yi1) < Eps Then
'MsgBox ("End point" & " dir=" & CStr(dir) & " jInit + dir=" & CStr(jInit + dir))
            If dir > 0 And jInit + dir = Con(kWork).NVer - 1 Then
                xj = Con(kWork).xVer(1)
                yj = Con(kWork).yVer(1)
                BetaMin(k2).jInit = 0
                GoTo UUU
            End If
            If dir < 0 And jInit + dir = 0 Then
                xj = Con(kWork).xVer(Con(kWork).NVer - 2)
                yj = Con(kWork).yVer(Con(kWork).NVer - 2)
                BetaMin(k2).jInit = Con(kWork).NVer - 1
                GoTo UUU
            End If
            xj = Con(kWork).xVer(jInit + 2 * dir)
            yj = Con(kWork).yVer(jInit + 2 * dir)
            BetaMin(k2).jInit = jInit + dir
UUU:
            beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
            BetaMin(k2).Bet = beta1
            BetaMin(k2).kk = kWork
            BetaMin(k2).ddir = dir
UU1:
        Else
            BetaMin(k2).Bet = 0
            BetaMin(k2).jInit = jInit
            BetaMin(k2).kk = kWork
            BetaMin(k2).ddir = dir
        End If
    Next k
Dim BeMin#
    BeMin = 2 * Pi
    For k = 0 To k2
        If BetaMin(k).Bet < BeMin Then
            kmin = k
            BeMin = BetaMin(k).Bet
        End If
    Next k
    xi = xinter
    yi = yinter
    xi1 = Con(BetaMin(kmin).kk).xVer(BetaMin(kmin).jInit + BetaMin(kmin).ddir)
    yi1 = Con(BetaMin(kmin).kk).yVer(BetaMin(kmin).jInit + BetaMin(kmin).ddir)
    jInit = BetaMin(kmin).jInit
    dir = BetaMin(kmin).ddir
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'Set Gr = Grs.AddStar(xi, yi, 0)
'Vi.Refresh
'MsgBox ("Intersect")
'Gr.Delete
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

    xRes(nRes) = xi
    yRes(nRes) = yi
    nRes = nRes + 1
    If nRes > 5000 Then
        InitNew = False
        Exit Function
    End If

    If Abs(xi - xBeg) < 10 * Eps And Abs(yi - yBeg) < 10 * Eps Then
 '       GCon.Closed = True
        GoTo EndInit
    End If
    kWork = BetaMin(kmin).kk
    GoTo LBEG1
EndInit:
    ConCom.NVer = nRes
ReDim ConCom.xVer(nRes)
ReDim ConCom.yVer(nRes)
    For i = 0 To nRes - 1
        ConCom.xVer(i) = xRes(i)
        ConCom.yVer(i) = yRes(i)
    Next i
    Exit Function

ErrHand:
'    MsgBox ("Error InitNew")
'    MsgBox Err.Description
    InitNew = False

End Function

Private Function PointIntoSegmentiInter(x1#, y1#, x2#, y2#, x#, y#) As Integer
Dim dx#, dy#, l#, sina#, cosa#
            PointIntoSegmentiInter = 0
            If Abs(x - x1) < Eps And Abs(y - y1) < Eps Then
                PointIntoSegmentiInter = 0
                Exit Function
            End If
            If Abs(x - x2) < Eps And Abs(y - y2) < Eps Then
                PointIntoSegmentiInter = 1
                Exit Function
            End If

Dim xLoc#, yLoc#
            dx = x2 - x1
            dy = y2 - y1
            l = Sqr(dx * dx + dy * dy)
            If l < Eps Then Exit Function
            sina = dy / l
            cosa = dx / l

            yLoc = (y - y1) * cosa - (x - x1) * sina
            xLoc = (y - y1) * sina + (x - x1) * cosa
            If Abs(yLoc) > 10 * Eps Then
                PointIntoSegmentiInter = 0
                Exit Function
            End If
            If xLoc > 0 And xLoc < l Then
                PointIntoSegmentiInter = 1
                Exit Function
            End If
End Function

Private Function PointIntoSegmentjInter(x1#, y1#, x2#, y2#, x#, y#) As Integer
Dim dx#, dy#, l#, sina#, cosa#
            PointIntoSegmentjInter = 0
            If Abs(x - x1) < Eps And Abs(y - y1) < Eps Then
                PointIntoSegmentjInter = 1
                Exit Function
            End If
            If Abs(x - x2) < Eps And Abs(y - y2) < Eps Then
                PointIntoSegmentjInter = 1
                Exit Function
            End If
Dim xLoc#, yLoc#
            dx = x2 - x1
            dy = y2 - y1
            l = Sqr(dx * dx + dy * dy)
            If l < Eps Then Exit Function
            sina = dy / l
            cosa = dx / l

            yLoc = (y - y1) * cosa - (x - x1) * sina
            xLoc = (y - y1) * sina + (x - x1) * cosa
            If Abs(yLoc) > 10 * Eps Then
                PointIntoSegmentjInter = 0
                Exit Function
            End If
            If xLoc > 0 And xLoc < l Then
                PointIntoSegmentjInter = 1
                Exit Function
            End If

End Function

'  define point into First contour and outside Second contour
Private Sub PointInOut(Con0 As ContGeo, Con1 As ContGeo, x#, y#, Result As Boolean)
On Error GoTo ErrorHandler

Dim i As Long, j As Long, k As Long
Dim xi#, yi#, xi1#, yi1#, xj#, yj#, xj1#, yj1#
Dim ai#, bi#, di#, aj#, bj#, dj#
Dim xInt#, yInt#
Dim fi#
Dim dx#, dy#, dxx#, dyy#, dl#
    Result = False
Dim IntP As IntPoint
ReDim IntP.xInt(50)
ReDim IntP.yInt(50)
ReDim IntP.iInt(50)
ReDim IntP.jInt(50)
ReDim IntP.Pr(50)
Dim sina#, cosa#, alp1#, alp2#, alp#
Dim iInt As Long, jInt As Long
'MsgBox ("Befor")
    Call TwoContInter(Con0, Con1, IntP)
'MsgBox ("After")

    For i = 0 To IntP.nInt
        xInt = IntP.xInt(i)
        yInt = IntP.yInt(i)
        iInt = IntP.iInt(i)
        jInt = IntP.jInt(i)
        xi = Con0.xVer(iInt)
        yi = Con0.yVer(iInt)
        xi1 = Con0.xVer(iInt + 1)
        yi1 = Con0.yVer(iInt + 1)
        dx = xi1 - xi
        dy = yi1 - yi
        dl = Sqr(dx * dx + dy * dy)
        If Abs(dl) < Eps Then GoTo EEE
        sina = dy / dl
        cosa = dx / dl
        alp1 = Angle(sina, cosa)

        xj = Con1.xVer(jInt)
        yj = Con1.yVer(jInt)
        xj1 = Con1.xVer(jInt + 1)
        yj1 = Con1.yVer(jInt + 1)

        dx = xj1 - xj
        dy = yj1 - yj
        dl = Sqr(dx * dx + dy * dy)
        If Abs(dl) < Eps Then GoTo EEE
        sina = dy / dl
        cosa = dx / dl
        alp2 = Angle(sina, cosa)

If Abs(alp1 - alp2) < 0.1 Or Abs(Abs(alp1 - alp2) - Pi) < 0.1 Or Abs(Abs(alp1 - alp2) - 2 * Pi) < 0.1 Then GoTo EEE1
        alp = (alp1 + alp2) / 2
        For j = 0 To 3
            x = xInt + 0.05 * Cos(alp + j * Pi / 2)
            y = yInt + 0.05 * Sin(alp + j * Pi / 2)
            If PointInsideContouri(Con0, x, y) = 1 And PointIntoContouri(Con1, x, y) = 0 Then
                If Abs(alp + j * Pi * 2) < 0.1 Or Abs(alp + j * Pi * 2 - Pi) < 0.1 Or Abs(alp + j * Pi * 2 - 2 * Pi) < 0.1 Then
                    If alp + j * Pi * 2 > 0 Or alp + j * Pi * 2 - Pi > 0 Or alp + j * Pi * 2 - 2 * Pi > 0 Then
                        alp = alp + j * Pi / 2 + 0.05
                    Else
                        alp = alp + j * Pi / 2 - 0.05
                    End If
                    x = xInt + 1000 * Eps * Cos(alp)
                    y = yInt + 1000 * Eps * Sin(alp)
                End If

                Result = True
                Exit Sub
            End If
UU:
        Next j
EEE:
    Next i
    Exit Sub

EEE1:

    For i = 0 To Con0.NVer - 2
        xi = Con0.xVer(i)
        yi = Con0.yVer(i)
        xi1 = Con0.xVer(i + 1)
        yi1 = Con0.yVer(i + 1)
        dx = xi1 - xi
        dy = yi1 - yi
        dl = Sqr(dx * dx + dy * dy)
        If Abs(dl) < Eps Then GoTo S1
        If Abs(dy / dl) < 0.1 Then GoTo S1
        If Abs(dy / dl) > 0.9 Then GoTo S1
        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 + 1000 * Eps
        Else
            x = (xi1 + xi) / 2 + 1000 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointIntoContouri(Con1, x, y) = 0 Then
            Result = True
            Exit Sub
        End If

        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 - 1000 * Eps
        Else
            x = (xi1 + xi) / 2 - 1000 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointIntoContouri(Con1, x, y) = 0 Then
            Result = True
            Exit Sub
        End If
S1:
    Next i

    For i = 0 To Con1.NVer - 2
        xi = Con1.xVer(i)
        yi = Con1.yVer(i)
        xi1 = Con1.xVer(i + 1)
        yi1 = Con1.yVer(i + 1)
        dx = xi1 - xi
        dy = yi1 - yi
        dl = Sqr(dx * dx + dy * dy)
        If Abs(dl) < Eps Then GoTo S2
        If Abs(dy / dl) < 0.1 Then GoTo S2
        If Abs(dy / dl) > 0.9 Then GoTo S2
        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 + 1000 * Eps
        Else
            x = (xi1 + xi) / 2 + 1000 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointIntoContouri(Con1, x, y) = 0 Then
            Result = True
            Exit Sub
        End If

        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 - 1000 * Eps
        Else
            x = (xi1 + xi) / 2 - 1000 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointIntoContouri(Con1, x, y) = 0 Then
            Result = True
            Exit Sub
        End If
S2:
    Next i
Exit Sub
ErrorHandler:
'    MsgBox ("Error PointInOut")
'    MsgBox Err.Msg

End Sub

'  define point into First contour and outside Second contour
Private Sub PointInIn(Con0 As ContGeo, Con1 As ContGeo, x#, y#, Result As Boolean)
On Error GoTo ErrorHandler

Dim i As Long, j As Long, k As Long
Dim xi#, yi#, xi1#, yi1#, xj#, yj#, xj1#, yj1#
Dim ai#, bi#, di#, aj#, bj#, dj#
Dim xInt#, yInt#
Dim fi#
Dim dx#, dy#, dxx#, dyy#, dl#
    Result = False

Dim IntP As IntPoint
ReDim IntP.xInt(50)
ReDim IntP.yInt(50)
ReDim IntP.iInt(50)
ReDim IntP.jInt(50)
ReDim IntP.Pr(50)
Dim sina#, cosa#, alp1#, alp2#, alp#
Dim iInt As Long, jInt As Long

    Call TwoContInter(Con0, Con1, IntP)
    For i = 0 To IntP.nInt
        xInt = IntP.xInt(i)
        yInt = IntP.yInt(i)
        iInt = IntP.iInt(i)
        jInt = IntP.jInt(i)
        xi = Con0.xVer(iInt)
        yi = Con0.yVer(iInt)
        xi1 = Con0.xVer(iInt + 1)
        yi1 = Con0.yVer(iInt + 1)
        dx = xi1 - xi
        dy = yi1 - yi
        dl = Sqr(dx * dx + dy * dy)
        If Abs(dl) < Eps Then GoTo EEE
        sina = dy / dl
        cosa = dx / dl
        alp1 = Angle(sina, cosa)

        xj = Con1.xVer(jInt)
        yj = Con1.yVer(jInt)
        xj1 = Con1.xVer(jInt + 1)
        yj1 = Con1.yVer(jInt + 1)
        dx = xj1 - xj
        dy = yj1 - yj
        dl = Sqr(dx * dx + dy * dy)
        If Abs(dl) < Eps Then GoTo EEE
        sina = dy / dl
        cosa = dx / dl
        alp2 = Angle(sina, cosa)

If Abs(alp1 - alp2) < 0.1 Or Abs(Abs(alp1 - alp2) - Pi) < 0.1 Or Abs(Abs(alp1 - alp2) - 2 * Pi) < 0.1 Then GoTo EEE1
        alp = (alp1 + alp2) / 2
        For j = 0 To 3
            x = xInt + 0.05 * Cos(alp + j * Pi / 2)
            y = yInt + 0.05 * Sin(alp + j * Pi / 2)
            If PointInsideContouri(Con0, x, y) = 1 And PointInsideContouri(Con1, x, y) = 1 Then
                If Abs(alp + j * Pi * 2) < 0.1 Or Abs(alp + j * Pi * 2 - Pi) < 0.1 Or Abs(alp + j * Pi * 2 - 2 * Pi) < 0.1 Then
                    If alp + j * Pi * 2 > 0 Or alp + j * Pi * 2 - Pi > 0 Or alp + j * Pi * 2 - 2 * Pi > 0 Then
                        alp = alp + j * Pi / 2 + 0.05
                    Else
                        alp = alp + j * Pi / 2 - 0.05
                    End If
                    x = xInt + 1000 * Eps * Cos(alp)
                    y = yInt + 1000 * Eps * Sin(alp)
                End If
                Result = True
                Exit Sub
            End If
UU:
        Next j
    Next i
EEE:
    Exit Sub

EEE1:

    For i = 0 To Con0.NVer - 2
        xi = Con0.xVer(i)
        yi = Con0.yVer(i)
        xi1 = Con0.xVer(i + 1)
        yi1 = Con0.yVer(i + 1)
        dx = xi1 - xi
        dy = yi1 - yi
        dl = Sqr(dx * dx + dy * dy)
        If Abs(dl) < Eps Then GoTo S1
        If Abs(dy / dl) < 0.1 Then GoTo S1
        If Abs(dy / dl) > 0.9 Then GoTo S1
        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 + 1000 * Eps
        Else
            x = (xi1 + xi) / 2 + 1000 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointInsideContouri(Con1, x, y) = 1 Then
            Result = True
            Exit Sub
        End If

        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 - 1000 * Eps
        Else
            x = (xi1 + xi) / 2 - 1000 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointInsideContouri(Con1, x, y) = 1 Then
            Result = True
            Exit Sub
        End If
S1:
    Next i

    For i = 0 To Con1.NVer - 2
        xi = Con1.xVer(i)
        yi = Con1.yVer(i)
        xi1 = Con1.xVer(i + 1)
        yi1 = Con1.yVer(i + 1)
        dx = xi1 - xi
        dy = yi1 - yi
        dl = Sqr(dx * dx + dy * dy)
        If Abs(dl) < Eps Then GoTo S2
        If Abs(dy / dl) < 0.1 Then GoTo S2
        If Abs(dy / dl) > 0.9 Then GoTo S2
        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 + 1000 * Eps
        Else
            x = (xi1 + xi) / 2 + 1000 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointInsideContouri(Con1, x, y) = 1 Then
            Result = True
            Exit Sub
        End If

        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 - 1000 * Eps
        Else
            x = (xi1 + xi) / 2 - 1000 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointInsideContouri(Con1, x, y) = 1 Then
            Result = True
            Exit Sub
        End If
S2:
    Next i
Exit Sub
ErrorHandler:
'    MsgBox ("Error PointInIn")
'    MsgBox Err.Msg

End Sub

Private Sub Intersect(Con0 As ContGeo, Con1 As ContGeo, NumContSubtr As Long, ContInter() As ContGeo, x#, y#, IntP As IntPoint, Result As Boolean)
On Error GoTo ErrorHandler

Dim i As Long, j As Long, k As Long
Dim xi#, yi#, xi1#, yi1#, xj#, yj#, xj1#, yj1#
Dim ai#, bi#, di#, aj#, bj#, dj#
Dim xInt#, yInt#
Dim fi#
Dim dx#, dy#, dxx#, dyy#, dl#
    Result = False
Dim sina#, cosa#, alp1#, alp2#, alp#
Dim iInt As Long, jInt As Long

    For i = 0 To IntP.nInt
        If IntP.Pr(i) = True Then GoTo EEE
        xInt = IntP.xInt(i)
        yInt = IntP.yInt(i)
        iInt = IntP.iInt(i)
        jInt = IntP.jInt(i)
        xi = Con0.xVer(iInt)
        yi = Con0.yVer(iInt)
        xi1 = Con0.xVer(iInt + 1)
        yi1 = Con0.yVer(iInt + 1)
        dx = xi1 - xi
        dy = yi1 - yi
        dl = Sqr(dx * dx + dy * dy)
        If Abs(dl) < Eps Then GoTo EEE
        sina = dy / dl
        cosa = dx / dl
        alp1 = Angle(sina, cosa)

        xj = Con1.xVer(jInt)
        yj = Con1.yVer(jInt)
        xj1 = Con1.xVer(jInt + 1)
        yj1 = Con1.yVer(jInt + 1)
        dx = xj1 - xj
        dy = yj1 - yj
        dl = Sqr(dx * dx + dy * dy)
        If Abs(dl) < Eps Then GoTo EEE
        sina = dy / dl
        cosa = dx / dl
        alp2 = Angle(sina, cosa)

If Abs(alp1 - alp2) < 0.1 Or Abs(Abs(alp1 - alp2) - Pi) < 0.1 Or Abs(Abs(alp1 - alp2) - 2 * Pi) < 0.1 Then GoTo EEE1
        alp = (alp1 + alp2) / 2
        For j = 0 To 3
            x = xInt + 100 * Eps * Cos(alp + j * Pi / 2)
            y = yInt + 100 * Eps * Sin(alp + j * Pi / 2)
            If PointInsideContouri(Con0, x, y) = 1 And PointInsideContouri(Con1, x, y) = 1 Then
                For k = 0 To NumContSubtr
                    If PointIntoContouri(ContInter(k), x, y) = 1 Then GoTo UU
                Next k
                If Abs(alp + j * Pi * 2) < 0.1 Or Abs(alp + j * Pi * 2 - Pi) < 0.1 Or Abs(alp + j * Pi * 2 - 2 * Pi) < 0.1 Then
                    If alp + j * Pi * 2 > 0 Or alp + j * Pi * 2 - Pi > 0 Or alp + j * Pi * 2 - 2 * Pi > 0 Then
                        alp = alp + j * Pi / 2 + 0.05
                    Else
                        alp = alp + j * Pi / 2 - 0.05
                    End If
                    x = xInt + 1000 * Eps * Cos(alp)
                    y = yInt + 1000 * Eps * Sin(alp)
                End If
                IntP.Pr(i) = True
                Result = True
                Exit Sub
            End If
UU:
        Next j
EEE:
    Next i
    Exit Sub

EEE1:

    For i = 0 To Con0.NVer - 2
        xi = Con0.xVer(i)
        yi = Con0.yVer(i)
        xi1 = Con0.xVer(i + 1)
        yi1 = Con0.yVer(i + 1)
        dx = xi1 - xi
        dy = yi1 - yi
        dl = Sqr(dx * dx + dy * dy)
        If Abs(dl) < Eps Then GoTo S21
        If Abs(dy / dl) < 0.1 Then GoTo S21
        If Abs(dy / dl) > 0.9 Then GoTo S21
        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 + 1000 * Eps
        Else
            x = (xi1 + xi) / 2 + 1000 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointInsideContouri(Con1, x, y) = 1 Then
            For k = 0 To NumContSubtr
                If PointIntoContouri(ContInter(k), x, y) = 1 Then GoTo S11
            Next k
            Result = True
            Exit Sub
        End If
S11:
        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 - 1000 * Eps
        Else
            x = (xi1 + xi) / 2 - 1000 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointInsideContouri(Con1, x, y) = 1 Then
            For k = 0 To NumContSubtr
                If PointIntoContouri(ContInter(k), x, y) = 1 Then GoTo S21
            Next k
            Result = True
            Exit Sub
        End If
S21:
    Next i

    For i = 0 To Con1.NVer - 2
        xi = Con1.xVer(i)
        yi = Con1.yVer(i)
        xi1 = Con1.xVer(i + 1)
        yi1 = Con1.yVer(i + 1)
        dx = xi1 - xi
        dy = yi1 - yi
        dl = Sqr(dx * dx + dy * dy)
        If Abs(dl) < Eps Then GoTo S2
        If Abs(dy / dl) < 0.1 Then GoTo S2
        If Abs(dy / dl) > 0.9 Then GoTo S2
        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 + 1000 * Eps
        Else
            x = (xi1 + xi) / 2 + 1000 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointInsideContouri(Con1, x, y) = 1 Then
            For k = 0 To NumContSubtr
                If PointIntoContouri(ContInter(k), x, y) = 1 Then GoTo S1
            Next k
            Result = True
            Exit Sub
        End If
S1:
        If Abs(dy / dl) < 0.7 Then
            x = (xi1 + xi) / 2
            y = (yi1 + yi) / 2 - 1000 * Eps
        Else
            x = (xi1 + xi) / 2 - 1000 * Eps
            y = (yi1 + yi) / 2
        End If

        If PointInsideContouri(Con0, x, y) = 1 And PointInsideContouri(Con1, x, y) = 1 Then
            For k = 0 To NumContSubtr
                If PointIntoContouri(ContInter(k), x, y) = 1 Then GoTo S2
            Next k
            Result = True
            Exit Sub
        End If
S2:
    Next i

    Exit Sub

ErrorHandler:
'    MsgBox ("Error Intersect")
'    MsgBox Err.Msg

End Sub

'  define point into First contour and outside Second contour
Private Function DoubleLineInter(Cont As ContGeo, ConExt As ContGeo, ConInt() As ContGeo, nInt As Long, IntP As IntPoint) As Boolean
On Error GoTo ErrorHandler
    DoubleLineInter = True
Dim i As Long, j As Long, k As Long
Dim xInt#, yInt#
Dim fi#, x#, y#
    nInt = 0
Dim Ver As Object
Dim ConEx As ContGeo
' Create External contour
        Call LeftPointTwoGrap(Cont, Cont, x, y)
        Call InitNew(Cont, Cont, 2, x, y, ConEx)
        Set Gr = Grs.Add(11)
        Gr.Properties("Thickness") = 0
        For i = 0 To ConEx.NVer - 1
            Set Ver = Gr.Vertices.Add(ConEx.xVer(i), ConEx.yVer(i), 0)
        Next i
        For i = 0 To IntP.nInt
            If PointInsideContouri(ConEx, IntP.xInt(i), IntP.yInt(i)) = 0 Then
                IntP.Pr(i) = True
            End If
        Next i
'Vi.Refresh
'MsgBox ("External")

' Create Intersected areas
Dim IntCont(100) As ContGeo
Dim IntN As Long
        IntN = -1
        For i = 0 To IntP.nInt
            If IntP.Pr(i) = True Then
'MsgBox ("111111")

                For j = 0 To IntN
                    If PointIntoContouri(IntCont(j), IntP.xInt(i), IntP.yInt(i)) = 1 Then GoTo TT4
                Next j
                xInt = IntP.xInt(i)
                yInt = IntP.yInt(i)
'Set Gr = Grs.AddCircle(xInt, yInt, 0)
'Vi.Refresh
'MsgBox ("111111")
                For fi = 0.3 To 2 * Pi + 0.3 Step Pi / 20
                    x = xInt + 1000 * Eps * Cos(fi)
                    y = yInt + 1000 * Eps * Sin(fi)
                    If PointInsideContouri(ConEx, x, y) = 1 And PointIntoContouri(Cont, x, y) = 0 Then
                        For j = 0 To IntN
                            If PointIntoContouri(IntCont(j), x, y) = 1 Then GoTo TT4
                        Next j
                        IntN = IntN + 1
                        Call InitNew(Cont, Cont, 2, x, y, IntCont(IntN))
'                        Set Gr = Grs.Add(11)
'                        For j = 0 To IntCont(IntN).NVer - 1
'                            Set Ver = Gr.Vertices.Add(IntCont(IntN).xVer(j), IntCont(IntN).yVer(j), 0)
'                        Next j
'Vi.Refresh
'MsgBox ("FFFFFF")
                        GoTo TT4:
                    End If
                Next fi
            End If
TT4:
        Next i

Dim ContInti(100) As ContGeo

        For i = 0 To IntP.nInt
            If IntP.Pr(i) = False Then
                xInt = IntP.xInt(i)
                yInt = IntP.yInt(i)
                For j = 0 To nInt
                    If PointIntoContouri(ContInti(j), IntP.xInt(i), IntP.yInt(i)) = 1 Then GoTo TT5
                Next j

                xInt = IntP.xInt(i)
                yInt = IntP.yInt(i)
                For j = 0 To IntN
                    If PointIntoContouri(IntCont(j), IntP.xInt(i), IntP.yInt(i)) = 1 Then Exit For
                Next j
Dim j0 As Long
                j0 = j
                For fi = 0.3 To 2 * Pi + 0.3 Step Pi / 20
                    x = xInt + 1000 * Eps * Cos(fi)
                    y = yInt + 1000 * Eps * Sin(fi)
                    If PointIntoContouri(Cont, x, y) = 0 Then
                        If PointIntoContouri(IntCont(j0), x, y) = 1 Then GoTo TT6

                        Call InitNew(Cont, Cont, 2, x, y, ContInti(n0Int))
                        Set Gr = Grs.Add(11)
                        Gr.Properties("Thickness") = 0
                       For j = 0 To ContInti(nInt).NVer - 1
                            Set Ver = Gr.Vertices.Add(ContInti(nInt).xVer(j), ContInti(nInt).yVer(j), 0)
                        Next j
                        nInt = nInt + 1

'Vi.Refresh
'MsgBox ("111")
                        GoTo TT5:
                    End If
TT6:
                Next fi
            End If
TT5:
        Next i
        ConExt = ConEx
ReDim ConInt(nInt)
        For i = 0 To nInt - 1
            ConInt(i) = ContInti(i)
        Next i

'MsgBox ("End Func")
    Exit Function
ErrorHandler:
'    MsgBox ("Error PointInOut")
'    MsgBox Err.Msg
    DoubleLineInter = False
End Function

' Function return 1 - if point lies inside of the contour or on o bounds of the contour,
' or 0 - if point lies outside

Private Function PointIntoContouri(Con As ContGeo, xc#, yc#) As Integer
On Error GoTo ErrorHandler
Dim nV As Long, i%
Dim xi#, yi#, xi1#, yi1#
Dim xLoci#, yLoci#, xLoci1#, yLoci1#
Dim nInt%
Dim a1#, b1#, d1#
Dim xIntLoc#
Dim sina#, cosa#
    nV = Con.NVer
    nInt = 0
    sina = 0.5
    cosa = Sqr(3) / 2
    For i = 0 To nV - 2
        xi = Con.xVer(i)
        yi = Con.yVer(i)
        xi1 = Con.xVer(i + 1)
        yi1 = Con.yVer(i + 1)
        If Abs(xi - xi1) < Eps And Abs(yi - yi1) < Eps Then GoTo WW1
        If Abs(xc - xi) < Eps And Abs(yc - yi) < Eps Then
            PointIntoContouri = 1
            Exit Function
        End If
        If Abs(xc - xi1) < Eps And Abs(yc - yi1) < Eps Then
            PointIntoContouri = 1
            Exit Function
        End If
        If Abs(yi - yi1) < Eps Then
            If Abs(yc - yi) < Eps And PointIntoSegmenti(xi, yi, xi1, yi1, xc, yc) = 1 Then
                PointIntoContouri = 1
                Exit Function
            End If
        End If

        yLoci = (yi - yc) * cosa - (xi - xc) * sina
        xLoci = (yi - yc) * sina + (xi - xc) * cosa
        yLoci1 = (yi1 - yc) * cosa - (xi1 - xc) * sina
        xLoci1 = (yi1 - yc) * sina + (xi1 - xc) * cosa

        If yLoci > 10 * Eps And yLoci1 > 10 * Eps Then GoTo WW1
        If yLoci < -10 * Eps And yLoci1 < -10 * Eps Then GoTo WW1
        If Abs(yLoci - yLoci1) < Eps Then GoTo WW1      'And Abs(yLocj) > 10 * Eps
        If xLoci < -10 * Eps And xLoci1 < -10 * Eps Then GoTo WW1
        If Sgn(yLoci) <> Sgn(yLoci1) Then
            a1 = -(yLoci1 - yLoci)
            b1 = xLoci1 - xLoci
            d1 = a1 * xLoci + b1 * yLoci
            If Abs(a1) < Eps And Abs(b1) < Eps Then GoTo WW1
            xIntLoc = d1 / a1
      ' If point on line
            If Abs(xIntLoc) < Eps Then
                PointIntoContouri = 1
                Exit Function
            End If
            If xIntLoc > Eps Then
                nInt = nInt + 1
            End If
        End If
WW1:
    Next i
    If nInt = 0 Or nInt = 2 Or nInt = 4 Or nInt = 6 Or nInt = 8 Or nInt = 10 Or nInt = 12 Then
        PointIntoContouri = 0
    Else
        PointIntoContouri = 1
    End If
    Exit Function

ErrorHandler:
'    MsgBox ("Error PointIntoContouri")
'    MsgBox Err.Msg

End Function

' Function return 1 - if point lies inside of the contour ,
' or 0 - if point lies outside or on o bounds of the contour

Private Function PointInsideContouri(Con As ContGeo, xc#, yc#) As Integer
On Error GoTo ErrorHandler
Dim nV As Long, i%
Dim xi#, yi#, xi1#, yi1#
Dim xLoci#, yLoci#, xLoci1#, yLoci1#
Dim nInt%
Dim a1#, b1#, d1#
Dim xIntLoc#
Dim sina#, cosa#
    nV = Con.NVer
    nInt = 0
    sina = 0.5
    cosa = Sqr(3) / 2
    For i = 0 To nV - 2
        xi = Con.xVer(i)
        yi = Con.yVer(i)
        xi1 = Con.xVer(i + 1)
        yi1 = Con.yVer(i + 1)
        If Abs(xi - xi1) < Eps And Abs(yi - yi1) < Eps Then GoTo WW1
        If Abs(xc - xi) < Eps And Abs(yc - yi) < Eps Then
            PointInsideContouri = 0
            Exit Function
        End If
        If Abs(xc - xi1) < Eps And Abs(yc - yi1) < Eps Then
            PointInsideContouri = 0
            Exit Function
        End If
        If Abs(yi - yi1) < Eps Then
            If Abs(yc - yi) < Eps And PointIntoSegmenti(xi, yi, xi1, yi1, xc, yc) = 1 Then
                PointInsideContouri = 0
                Exit Function
            End If
        End If

        yLoci = (yi - yc) * cosa - (xi - xc) * sina
        xLoci = (yi - yc) * sina + (xi - xc) * cosa
        yLoci1 = (yi1 - yc) * cosa - (xi1 - xc) * sina
        xLoci1 = (yi1 - yc) * sina + (xi1 - xc) * cosa

        If yLoci > 10 * Eps And yLoci1 > 10 * Eps Then GoTo WW1
        If yLoci < -10 * Eps And yLoci1 < -10 * Eps Then GoTo WW1
        If Abs(yLoci - yLoci1) < Eps Then GoTo WW1      'And Abs(yLocj) > 10 * Eps
        If xLoci < -10 * Eps And xLoci1 < -10 * Eps Then GoTo WW1
        If Sgn(yLoci) <> Sgn(yLoci1) Then
            a1 = -(yLoci1 - yLoci)
            b1 = xLoci1 - xLoci
            d1 = a1 * xLoci + b1 * yLoci
            If Abs(a1) < Eps And Abs(b1) < Eps Then GoTo WW1
            xIntLoc = d1 / a1
      ' If point on line
            If Abs(xIntLoc) < Eps Then
                PointInsideContouri = 0
                Exit Function
            End If
            If xIntLoc > Eps Then
                nInt = nInt + 1
            End If
        End If
WW1:
    Next i
    If nInt = 0 Or nInt = 2 Or nInt = 4 Or nInt = 6 Or nInt = 8 Or nInt = 10 Or nInt = 12 Then
        PointInsideContouri = 0
    Else
        PointInsideContouri = 1
    End If
    Exit Function

ErrorHandler:
'    MsgBox ("Error PointInsideContouri")
'    MsgBox Err.Msg

End Function

' Create data for selected object
' GrSel - selected object
' ContExt - structure of data for external contour
' ContInt() - array of structures of data for internal contour
' nGInt - count of internal contours

Private Function InitSelectedNew(GrSel As Graphic, ContExt As ContGeo, ContInt() As ContGeo, nGInt As Long) As Boolean
On Error GoTo ErrorHandler
Dim GrSets As GraphicSets
Dim GrSet As GraphicSet
Dim SetCount As Long, i As Long, j As Long
Dim Con(100) As ContGeo
    Set GrSets = Dr.GraphicSets
    Set GrSet = GrSets.Add("PickGraphics")
    If PResToGrSet(GrSel, GrSet) = False Then
        InitSelectedNew = False
        Exit Function
    End If
    SetCount = GrSet.Count
    For i = 0 To SetCount - 1
        Set Gr = GrSet.Item(i)
        If InitPicRes(Gr, Con(i)) = False Then
            InitSelectedNew = False
            Exit Function
        End If
    Next i
    ' If contour intersects someself
Dim IntP As IntPoint
ReDim IntP.xInt(100)
ReDim IntP.yInt(100)
ReDim IntP.iInt(100)
ReDim IntP.jInt(100)
ReDim IntP.Pr(100)
    For i = 0 To SetCount - 1
        If TwoContInter(Con(i), Con(i), IntP) = True And IntP.nInt > 0 Then
            Beep
            MsgBox "Object selfintersects.Select another one.", 0, "2D Boolean Operations"
            InitSelectedNew = False
            TryAgain = True
            Exit Function
        End If
    Next i

    ContExt = Con(0)
    nGInt = SetCount - 1
    If nGInt < 1 Then
        GoTo l0
    Else
ReDim ContInt(nGInt)
    End If
    For i = 0 To nGInt - 1
        ContInt(i) = Con(i + 1)

    Next i
Dim Loc As String
        For i = 0 To nGInt - 1
            Loc = Location(ContExt, ContInt(i))
            If Loc = "Intersect" Then
                InitSelectedNew = False
                Beep
'                MsgBox "Object can't be selected because it has at least two contours intersecting one other. Look for another object to select.", 0, "2D Boolean Operations"
                MsgBox LoadResString(125), 0, LoadResString(118)
                TryAgain = True
                Exit Function
            End If
            For j = i + 1 To nGInt - 1
                Loc = Location(ContInt(i), ContInt(j))
                If Loc = "Intersect" Then
                    InitSelectedNew = False
                    Beep
'                    MsgBox "Object can't be selected because it has at least two contours intersecting one other. Look for another object to select.", 0, "2D Boolean Operations"
                    MsgBox LoadResString(125), 0, LoadResString(118)
                    TryAgain = True
                    Exit Function

                End If
            Next j
        Next i

' If there are External contour
'***********************************
        If nGInt > 1 Then
            For i = 0 To nGInt - 1
                Loc = Location(ContExt, ContInt(i))
                If Loc <> "NonIntersect" Then GoTo Q1
            Next i
            InitSelectedNew = False
            Beep
'            MsgBox "Object consist of several separate contours. Select another one.", 0, "2D Boolean Operations"
            MsgBox LoadResString(126), 0, LoadResString(118)
            TryAgain = True
            Exit Function
Q1:
            For i = 0 To nGInt - 1
                Loc = Location(ContExt, ContInt(i))
                For j = 0 To nGInt - 1
                    If i <> j Then
                        If Location(ContInt(i), ContInt(j)) <> "NonIntersect" Or Loc <> "NonIntersect" Then GoTo Q2
                    End If
                Next j
                InitSelectedNew = False
                Beep
'                MsgBox "Object consist of several separate contours. Select another one.", 0, "2D Boolean Operations"
                MsgBox LoadResString(126), 0, LoadResString(118)
                TryAgain = True
                Exit Function
Q2:
            Next i
        End If
        If nGInt = 1 Then
            Loc = Location(ContExt, ContInt(0))
            If Loc = "NonIntersect" Then
                InitSelectedNew = False
                Beep
'                MsgBox "Object consist of several separate contours. Select another one.", 0, "2D Boolean Operations"
                MsgBox LoadResString(126), 0, LoadResString(118)
                TryAgain = True
                Exit Function
            End If
        End If

'***********************************
Dim ConW As ContGeo
'MsgBox ("1111111")
        If Location(ContExt, ContInt(0)) = "External" Then GoTo l0
'MsgBox ("222222")
        For i = 0 To nGInt - 1
            If Location(ContInt(i), ContExt) = "External" Then
                ConW = ContInt(i)
                ContInt(i) = ContExt
                ContExt = ConW
                GoTo l0
            End If
            For j = 0 To nGInt - 1
                If i = j Then GoTo L1
                If Location(ContInt(i), ContInt(j)) = "External" Then
                    ConW = ContInt(i)
                    ContInt(i) = ContExt
                    ContExt = ConW
                    GoTo l0
                End If
L1:
            Next j
        Next i
l0:
'    GrSel.Select
    InitSelectedNew = True
    GrSet.Clear
    Set GrSet = Nothing
    Set GrSets = Nothing
 Exit Function

ErrorHandler:
'    MsgBox ("Error PointInsideContouri")
'    MsgBox Err.Msg
    InitSelectedNew = False

End Function
Private Function PResToGrSet(GrPick As Graphic, GrSet As GraphicSet) As Boolean
    PResToGrSet = True
'MsgBox ("11111")
'
'On Error GoTo ErrHand
Dim i As Long, j As Long, k As Long
Dim GrType As String
Dim GroupCount As Long
Dim GrDup As Graphic
Dim GrSe As GraphicSet
Dim GrDupIndex As Long
Dim nV As Long
Dim GrE As Graphic
Dim Ver As Vertex
'Dim Vers As Vertices
Dim VerE As Vertex
Dim nGDbl As Long

        GrType = GrPick.Type
'MsgBox (GrType & "  " & CStr(GrPick.Graphics.Count))
        If GrType = "TCW30POINT" Then GoTo L2
        If GrType = "TCW25DimLin" Then GoTo L2
        If GrType = "TCW25DimDat" Then GoTo L2
        If GrType = "TCW25DimAng" Then GoTo L2
        If GrType = "TCW25DimRad" Then GoTo L2
        If GrType = "TCW25DimDia" Then GoTo L2
        If GrType = "TCW25DimLead" Then GoTo L2
        If GrType = "TC_Multiline" Then GoTo L2
        If GrType = "TCW60Wall" Then GoTo L2

        If GrType = "TCW40CUBE" Then GoTo L2
        If GrType = "TCW40SPHERE" Then GoTo L2
        If GrType = "TCW40LOFT" Then GoTo L2
        If GrType = "TCW40EXTRUDE" Then GoTo L2
        If GrType = "TCW40SPIN" Then GoTo L2
        If GrType = "TCW60ACISSOLID" Then GoTo L2
        If GrType = SURFACETYPE Then GoTo L2

        If GrType = INSERTTYPE Then GoTo L2
        If GrType = GRAPHICTYPE And GrPick.Graphics.Count > 1 Then GoTo L2
        On Error Resume Next
Dim LayerName As String
        LayerName = "    "
        LayerName = GrPick.Layer.Name
        If LayerName = "$CONSTRUCTION" Then GoTo L2
Dim BrushStyle As String
        BrushStyle = "    "

        GroupCount = GrPick.Graphics.Count
        If GroupCount = 0 Then
            If GrPick.Properties("Thickness") <> 0 Then GoTo L2
        End If
'MsgBox (GrType & "  GroupCount=" & CStr(GroupCount))
        If GrType = GRAPHICTYPE Then
            If GroupCount = 0 Then
                Call ExplodeWithUnVisible(GrPick, GrSet)
'                GrSet.AddGraphic GrPick
            Else
                 If GrPick.Graphics.Count = 1 And GrPick.Graphics(0).Type = DATATYPE Then
                    GrSet.AddGraphic GrPick
                    GoTo L1
                End If
'               For j = 0 To GroupCount - 1
'                    Set Gr = GrPick.Graphics.Item(j)
'                    GrSet.AddGraphic Gr
'                Next j
            End If
            GoTo L1
        End If
'**************************************************************************
        If GrType = INSERTTYPE Then

            Set GrDup = GrPick.Duplicate
            GrDupIndex = GrDup.Index
            Grs.Remove (GrDupIndex)
            Set GrSe = GrDup.Explode
            GroupCount = GrSe.Count
            For j = 0 To GroupCount - 1
                GrSet.AddGraphic GrSe.Item(j)
            Next j
            GrDup.Delete
            Set GrDup = Nothing
            GrSe.Clear
            Set GrSe = Nothing
            GoTo L1
        End If
'*********************************************************************************
        If GrType = "TCW50IntProp" Then ' If Graphic - HATCH
            If GrPick.Graphics.Item(0).Properties.Item("Info").Value = "Brush_Cosmetic" Then

'                Set Vers = GrPick.Vertices
'                nV = Vers.Count
'MsgBox ("nV=" & CStr(nV))
'                Set GrE = GrSet.Add(11)
'                For i = 0 To nV - 1
'                    Set Ver = GrE.Vertices.Add(Vers.Item(i).x, Vers.Item(i).y, 0)
'                    Ver.PenDown = True
'                Next i
'                Set Ver = Nothing
'                Set Vers = Nothing
'                Set GrE = Nothing
                Call ExplodeWithUnVisible(GrPick, GrSet)
                GoTo L1
            End If
            If GrPick.Graphics.Item(0).Properties.Item("Info").Value = "Line_Width_Cosmetic" Then
                If GrPick.Closed = False Then
                    Set Vers = GrPick.Graphics.Item(0).Vertices
                    nV = Vers.Count
                    Set GrE = GrSet.Add(11)
                    For i = 0 To nV - 1
                        Set Ver = GrE.Vertices.Add(Vers.Item(i).x, Vers.Item(i).y, 0)
                        Ver.PenDown = True
                    Next i
                Else
                    Set Vers = GrPick.Graphics.Item(0).Vertices
                    nV = Vers.Count
                    Set GrE = GrSet.Add(11)
                    Set Ver = Vers.Item(1)
                    Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                    For k = 2 To nV - 2
                        Set Ver = Vers.Item(k)
                        If Ver.PenDown = True Then
                            Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                            VerE.PenDown = True
                        Else
                            If Vers.Item(k + 1).PenDown = True And k + 1 <> nV - 1 Then
                                Set GrE = GrSet.Add(11)
                                Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                                VerE.PenDown = True
                            End If
                        End If
                    Next k
                    Set Ver = Vers.Item(nV - 1)
                    Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                End If
                Set Ver = Nothing
                Set VerE = Nothing
'                Set Vers = Nothing
                Set GrE = Nothing
                GoTo L1
            End If
        End If
'**************************************************************************
        If GrType = "TCW25DblLine" Then
            If GrPick.Closed = False Then
                nGDbl = GrPick.Graphics.Count
                Set Gr = GrPick.Graphics.Item(nGDbl - 1)
                Set Vers = Gr.Vertices
                nV = Vers.Count
                Set GrE = GrSet.Add(11)
                For i = 0 To nV - 1
                    Set Ver = GrE.Vertices.Add(Vers.Item(i).x, Vers.Item(i).y, 0)
                    Ver.PenDown = True
                Next i
            Else
                nGDbl = GrPick.Graphics.Count
                Set Gr = GrPick.Graphics.Item(nGDbl - 1)
                nV = Gr.Vertices.Count
                Set GrE = GrSet.Add(11)
                Set Vers = Gr.Vertices
                Set Ver = Vers.Item(0)
                Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                For k = 1 To nV - 2
                    Set Ver = Vers.Item(k)
                    If Ver.PenDown = True Then
                        Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                        VerE.PenDown = True
                    Else
                        If Vers.Item(k + 1).PenDown = True And k + 1 <> nV - 1 Then
                            Set GrE = GrSet.Add(11)
                            Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                            VerE.PenDown = True
                        End If
                    End If
                Next k
            End If
            Set Ver = Nothing
            Set VerE = Nothing
'            Set Vers = Nothing
            Set GrE = Nothing
            GoTo L1
        End If

' If GraphicType -CIRCLE ---------------------------------------------------------------
        If GrType = CIRCLETYPE Then
'MsgBox (GrPick.Graphics.Item(0).Properties.Item("Info").Value)
            If GrPick.Graphics.Count = 0 Then
                GrSet.AddGraphic GrPick
                GoTo L1
            Else
                If GrPick.Graphics.Count = 1 And GrPick.Graphics(0).Type = DATATYPE Then
                    GrSet.AddGraphic GrPick
                    GoTo L1
                End If
                If GrPick.Properties("BrushStyle") <> SOLIDTYPE And GrPick.Properties("BrushStyle") <> NONETYPE Then
                    GrSet.AddGraphic GrPick
                    GoTo L1
                End If

                If GrPick.Graphics.Item(0).Properties.Item("Info").Value = "Line_Width_Cosmetic" Then
                    Set Vers = GrPick.Graphics.Item(0).Vertices
                    nV = Vers.Count
'MsgBox ("nV=" & CStr(nV))
                    Set GrE = GrSet.Add(11)
                    Set Ver = Vers.Item(1)
                    Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                    For k = 2 To nV - 2
                        Set Ver = Vers.Item(k)
                        If Ver.PenDown = True Then
                            Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                            VerE.PenDown = True
                        Else
                            If Vers.Item(k + 1).PenDown = True And k + 1 <> nV - 1 Then
                                Set GrE = GrSet.Add(11)
                                Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                                VerE.PenDown = True
                            End If
                        End If
                    Next k
                    Set Ver = Vers.Item(nV - 1)
                    Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                    VerE.PenDown = True
                    Set Ver = Nothing
                    Set VerE = Nothing
'                    Set Vers = Nothing
                    Set GrE = Nothing
                    GrSe.Clear
                    Set GrSe = Nothing
                    Set GrDup = Nothing
                   GoTo L1
                End If
            End If
        End If
' ----------------------------------------------------------------------------------------

        If GrType = ARCTYPE Then
            If GrPick.Graphics.Count = 0 Then
                Beep
'                MsgBox "At least one of the object's contours is not closed. Look to another object to select.", 0, "2D Boolean Operations"
                MsgBox LoadResString(128), 0, LoadResString(118)
                TryAgain = True
                PResToGrSet = False
                Set Ver = Nothing
                Set VerE = Nothing
                Set Vers = Nothing
                Set GrE = Nothing
                Exit Function
            End If
            If GrPick.Graphics.Count = 1 And GrPick.Graphics(0).Type = DATATYPE Then
                Beep
'                MsgBox "At least one of the object's contours is not closed. Look to another object to select.", 0, "2D Boolean Operations"
                MsgBox LoadResString(128), 0, LoadResString(118)
                TryAgain = True
                PResToGrSet = False
                Set Ver = Nothing
                Set VerE = Nothing
                Set Vers = Nothing
                Set GrE = Nothing
                Exit Function
            End If
            If GrPick.Graphics.Item(0).Properties.Item("Info").Value = "Line_Width_Cosmetic" Then
                Set Vers = GrPick.Graphics.Item(0).Vertices
                nV = Vers.Count
                If GrPick.Closed = False Then
                    Set GrE = GrSet.Add(11)
                    For i = 0 To nV - 1
                        Set Ver = GrE.Vertices.Add(Vers.Item(i).x, Vers.Item(i).y, 0)
                        Ver.PenDown = True
                    Next i

                    Set Ver = Nothing
                    Set VerE = Nothing
'                    Set Vers = Nothing
                    Set GrE = Nothing
                    GoTo L1
                End If
            End If
        End If

        If GrType = "TCW30CURVE" Or GrType = "TCW50Polyline" Then
            If GrPick.Graphics.Item(1).Graphics.Item(0).Properties.Item("Info").Value <> "Line_Width_Cosmetic" Then
                GrSet.AddGraphic GrPick
                GoTo L1
            Else
                If GrPick.Closed = False Then
                    Set Vers = GrPick.Graphics.Item(1).Graphics.Item(0).Vertices
                    nV = Vers.Count
                    Set GrE = GrSet.Add(11)
                    For i = 0 To nV - 1
                        Set Ver = GrE.Vertices.Add(Vers.Item(i).x, Vers.Item(i).y, 0)
                        Ver.PenDown = True
                    Next i
                Else
                    Set Vers = GrPick.Graphics.Item(1).Graphics.Item(0).Vertices
                    nV = Vers.Count
                    Set GrE = GrSet.Add(11)
                    Set Ver = Vers.Item(1)
                    Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                    For k = 2 To nV - 2
                        Set Ver = Vers.Item(k)
                        If Ver.PenDown = True Then
                            Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                            VerE.PenDown = True
                        Else
                            If Vers.Item(k + 1).PenDown = True And k + 1 <> nV - 1 Then
                                Set GrE = GrSet.Add(11)
                                Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                                VerE.PenDown = True
                            End If
                        End If
                    Next k
                    Set Ver = Vers.Item(nV - 1)
                    Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                End If
                Set Ver = Nothing
                Set VerE = Nothing
'                Set Vers = Nothing
                Set GrE = Nothing
                GoTo L1
            End If
        End If
'        If GrType = TEXTTYPE Then
'            If GrPick.Properties.Item("TextMode").Value <> 3 Then GoTo L1
'        End If
      ' If single graphic
'        If GrType = TEXTTYPE Then
'           GrSet.AddGraphic GrPick
'           GoTo L1
'        End If
L2:
        Beep
'        MsgBox "Object is not valid for this operation. Select another object.", 0, "2D Boolean Operations"
        MsgBox LoadResString(127), 0, LoadResString(118)
        TryAgain = True
        PResToGrSet = False
        Exit Function
L1:
    Set Ver = Nothing
'    Set Vers = Nothing

    Exit Function
ErrHand:
'    MsgBox ("Error PRGrSet")
'    MsgBox Err.Description
    PResToGrSet = False
End Function

Private Function InitPicRes(Gr As Graphic, Con As ContGeo) As Boolean
On Error GoTo ErrHand
'MsgBox ("Begin InitPicRes")
    InitPicRes = True
Dim GrType As String
    GrType = Gr.Type
'    Con.GrInd = Gr.Index
    If GrType = CIRCLETYPE Then
        If CirclNew(Gr, Con) = True Then
            Exit Function
        Else
            InitPicRes = False
            Exit Function
        End If
    End If
    If GrType = "TCW30CURVE" Then
        If CurveNew(Gr, Con) = True Then
            Exit Function
        Else
            InitPicRes = False
            Exit Function
        End If
    End If
    If GrType = GRAPHICTYPE Then
        If GrapNew(Gr, Con) = True Then
'MsgBox ("InitPicRes nV=" & CStr(Con.NVer))
            Exit Function
        Else
            InitPicRes = False
            Exit Function
        End If
    End If
    If GrType = "TCW50Polyline" Then
        If MultiLNew(Gr, Con) = True Then
            Exit Function
        Else
            InitPicRes = False
            Exit Function
        End If
    End If

    Exit Function
ErrHand:
'    MsgBox Err.Description
    InitPicRes = False
End Function

' This function works with graphic - Curve and write coordinates it's child' vertices
' into structure Con, return - if object is closed else - False

Private Function CurveNew(GrSel As Graphic, Con As ContGeo) As Boolean
Dim nV As Long, i As Long
Dim Ver As Vertex, Vers As Vertices
On Error GoTo ErrHand
        CurveNew = True
        If GrSel.Properties("BrushStyle") = NONETYPE Or GrSel.Properties("BrushStyle") = SOLIDTYPE Then
            For i = 0 To GrSel.Graphics.Count - 1
                If GrSel.Graphics(i).Type = GRAPHICTYPE Then
                    Set Vers = GrSel.Graphics.Item(i).Vertices
                    Exit For
                End If
            Next i
        Else
            Set Vers = GrSel.Graphics(1).Vertices
        End If

        nV = Vers.Count
        Con.NVer = nV
ReDim Con.xVer(nV)
ReDim Con.yVer(nV)

        For i = 0 To nV - 1
            Set Ver = Vers.Item(i)
            Con.xVer(i) = Ver.x
            Con.yVer(i) = Ver.y
        Next i
        If Abs(Con.xVer(0) - Con.xVer(nV - 1)) < Eps And Abs(Con.yVer(0) - Con.yVer(nV - 1)) < Eps Then
            Con.xVer(0) = Con.xVer(nV - 1)
            Con.yVer(0) = Con.yVer(nV - 1)
        Else
            Beep
            MsgBox "At least one of the object's contours is not closed. Look to another object to select.", 0, "2D Boolean Operations"
            TryAgain = True
            CurveNew = False
        End If

        Set Ver = Nothing
        Set Vers = Nothing
    Exit Function
ErrHand:
'    MsgBox Err.Description
    CurveNew = False

End Function

' This function works with graphic - Circle and write coordinates it's child' vertices
' into structure Con, return - if object is closed else - False

Private Function CirclNew(GrSel As Graphic, Con As ContGeo) As Boolean
Dim nV As Long, i As Long
Dim Ver As Vertex
Dim xc#, yc#, ArcData(10) As Double
Dim xMax#, yMax#, a#, b#, sina#, cosa#, x#, y#, fi#, alp#, tet#, r#
On Error GoTo ErrHand

            CirclNew = True
            GrSel.GetArcData ArcData
            xc = ArcData(0)
            yc = ArcData(1)
            xMax = ArcData(3)
            yMax = ArcData(4)
            a = Sqr((xMax - xc) * (xMax - xc) + (yMax - yc) * (yMax - yc))
            b = a * ArcData(6)
            sina = (yMax - yc) / a
            cosa = (xMax - xc) / a
            alp = Angle(sina, cosa)
            nV = 41
            Con.NVer = nV
ReDim Con.xVer(nV)
ReDim Con.yVer(nV)
            For i = 0 To nV - 1
                fi = i * 2 * Pi / (nV - 1)
                x = a * Cos(fi)
                y = b * Sin(fi)
                If a <> b Then
                    r = Sqr(x * x + y * y)
                    sina = y / r
                    cosa = x / r
                    tet = Angle(sina, cosa)
                    tet = tet + alp
                    x = r * Cos(tet)
                    y = r * Sin(tet)
                End If
                Con.xVer(i) = xc + x
                Con.yVer(i) = yc + y
            Next i
            Con.xVer(nV - 1) = Con.xVer(0)
            Con.yVer(nV - 1) = Con.yVer(0)
            Set Ver = Nothing
    Exit Function
ErrHand:
'    MsgBox Err.Description
    CirclNew = False

End Function

' This function works with graphic - Graphic and write coordinates it's child' vertices
' into structure Con, return - if object is closed else - False

Private Function GrapNew(GrSel As Graphic, Con As ContGeo) As Boolean
Dim nV As Long, i As Long
Dim Ver As Vertex, Vers As Vertices
On Error GoTo ErrHand

        GrapNew = True
            Set Vers = GrSel.Vertices
            nV = Vers.Count
'MsgBox ("nV=" & CStr(nV))
            Con.NVer = nV
ReDim Con.xVer(nV)
ReDim Con.yVer(nV)
            For i = 0 To nV - 1
                Set Ver = Vers.Item(i)
                If i <> 0 And Ver.PenDown = False Then
                    Beep
'                    MsgBox "At least one of the object's contours is not closed. Look to another object to select.", 0, "2D Boolean Operations"
                    MsgBox LoadResString(128), 0, LoadResString(118)
                    TryAgain = True
                    GrapNew = False
                    Set Ver = Nothing
                    Set Vers = Nothing
                    Exit Function
                End If

                Con.xVer(i) = Ver.x
                Con.yVer(i) = Ver.y
            Next i
            If Abs(Con.xVer(0) - Con.xVer(nV - 1)) < Eps And Abs(Con.yVer(0) - Con.yVer(nV - 1)) < Eps Then
                Con.xVer(0) = Con.xVer(nV - 1)
                Con.yVer(0) = Con.yVer(nV - 1)
            Else
                Beep
 '               MsgBox "At least one of the object's contours is not closed. Look to another object to select.", 0, "2D Boolean Operations"
                MsgBox LoadResString(128), 0, LoadResString(118)
                TryAgain = True
                GrapNew = False
            End If

        Set Ver = Nothing
        Set Vers = Nothing
    Exit Function
ErrHand:
'    MsgBox Err.Description
    GrapNew = False

End Function

' This function works with MultiLine and write coordinates it's child' vertices
' into structure Con, return - if object is closed else - False

Private Function MultiLNew(GrSel As Graphic, Con As ContGeo) As Boolean
Dim nV As Long, i As Long
Dim Ver As Vertex, Vers As Vertices
On Error GoTo ErrHand
        MultiLNew = True

        If GrSel.Properties("BrushStyle") = NONETYPE Or GrSel.Properties("BrushStyle") = SOLIDTYPE Then
            For i = 0 To GrSel.Graphics.Count - 1
                If GrSel.Graphics(i).Type = GRAPHICTYPE Then
                    Set Vers = GrSel.Graphics.Item(i).Vertices
                    Exit For
                End If
            Next i
        Else
            Set Vers = GrSel.Graphics(0).Vertices
        End If

        nV = Vers.Count
        Con.NVer = nV
ReDim Con.xVer(nV)
ReDim Con.yVer(nV)
        For i = 0 To nV - 1
            Set Ver = Vers.Item(i)
            Con.xVer(i) = Ver.x
            Con.yVer(i) = Ver.y
        Next i
        If Abs(Con.xVer(0) - Con.xVer(nV - 1)) < Eps And Abs(Con.yVer(0) - Con.yVer(nV - 1)) < Eps Then
            Con.xVer(0) = Con.xVer(nV - 1)
            Con.yVer(0) = Con.yVer(nV - 1)
        Else
            Beep
            MsgBox "At least one of the object's contours is not closed. Look to another object to select.", 0, "2D Boolean Operations"
            TryAgain = True
            MultiLNew = False
        End If

        Set Ver = Nothing
        Set Vers = Nothing
    Exit Function
ErrHand:
'    MsgBox Err.Description
    MultiLNew = False

End Function

Private Function BiPointInter(Con As ContGeo, y#, xMin#, xMax#) As Integer
On Error GoTo ErrorHandler
Dim nV As Long, i%
Dim xi#, yi#, xi1#, yi1#
Dim nInt%
Dim a0#, b0#, d0#, a1#, b1#, d1#
Dim xInt#, yInt#
    xMin = 1000000
    xMax = -1000000
    nV = Con.NVer
    nInt = 0
    a0 = 0
    b0 = 1
    d0 = y

    For i = 0 To nV - 2
        xi = Con.xVer(i)
        yi = Con.yVer(i)
        xi1 = Con.xVer(i + 1)
        yi1 = Con.yVer(i + 1)
        If Abs(xi1 - xi) < Eps And Abs(yi1 - yi) < Eps Then GoTo WW1
        If yi - y > Eps And yi1 - y > Eps Then GoTo WW1
        If y - yi > Eps And y - yi1 > Eps Then GoTo WW1
        If Abs(yi1 - y) < Eps Then
            nInt = nInt + 1
            xInt = xi1
            If xi1 > xMax Then
                xMax = xi1
            End If
            If xi1 < xMin Then
                xMin = xi1
            End If
            GoTo WW1
        End If
        If Abs(yi - y) < Eps Then GoTo WW1

        a1 = -(yi1 - yi)
        b1 = xi1 - xi
        d1 = a1 * xi + b1 * yi
        Call SysLine(a0, b0, d0, a1, b1, d1, xInt, yInt)
        nInt = nInt + 1
        If xInt > xMax Then
            xMax = xInt
        End If
        If xInt < xMin Then
            xMin = xInt
        End If
WW1:
    Next i
    BiPointInter = nInt

    Exit Function

ErrorHandler:
 '   MsgBox ("Error PointInsideContourii")
 '   MsgBox Err.Msg
End Function

' Define all points intersection -xInt(N) for closed contour - Con with horizontal
' line with coordinate -y

Private Function AllPointInter(Con As ContGeo, y#, ConInt() As HorizInt) As Integer
On Error GoTo ErrorHandler
Dim nV As Long, i As Long
Dim xi#, yi#, xi1#, yi1#
Dim nInt As Long
Dim a0#, b0#, d0#, a1#, b1#, d1#
Dim xInt#, yInt#
    nV = Con.NVer
    nInt = -1
    a0 = 0
    b0 = 1
    d0 = y

    For i = 0 To nV - 2
        xi = Con.xVer(i)
        yi = Con.yVer(i)
        xi1 = Con.xVer(i + 1)
        yi1 = Con.yVer(i + 1)
        If Abs(xi1 - xi) < Eps And Abs(yi1 - yi) < Eps Then GoTo WW1
        If yi - y > Eps And yi1 - y > Eps Then GoTo WW1
        If y - yi > Eps And y - yi1 > Eps Then GoTo WW1
        If Abs(yi1 - y) < Eps Then
            nInt = nInt + 1
            ConInt(nInt).xInt = xi1
            ConInt(nInt).yInt = y
            GoTo WW1
        End If
        If Abs(yi - y) < Eps Then GoTo WW1

        a1 = -(yi1 - yi)
        b1 = xi1 - xi
        d1 = a1 * xi + b1 * yi
        Call SysLine(a0, b0, d0, a1, b1, d1, xInt, yInt)
        nInt = nInt + 1
        ConInt(nInt).xInt = xInt
        ConInt(nInt).yInt = y

WW1:
    Next i
    AllPointInter = nInt

    Exit Function

ErrorHandler:
 '   MsgBox ("Error PointInsideContourii")
 '   MsgBox Err.Msg
End Function

Private Function HorizontalIntersection(Con() As ContGeo, Ncont As Long, iExt As Long)
Dim i As Long, j As Long, nV As Long
Dim GrGroup As Graphic
Dim GrChild As Graphic
Dim GrHatch As Graphic
Dim Vers As Vertices
    Set GrGroup = Grs.Add(11)
    For i = 0 To Ncont
        Set GrChild = GrGroup.Graphics.Add(11)
        nV = Con(i).NVer
        With GrChild.Vertices
            For j = 0 To nV - 1
                .Add Con(i).xVer(j), Con(i).yVer(j), 0
            Next j
        End With
        GrChild.Closed = True
    Next i

    Set Gr = GrGroup.Graphics.AddHatch
    GrGroup.Deleted = True

    Gr.Properties("PenColor") = GrFirstPenColor
    Gr.Properties("PenStyle") = GrFirstPenStyle
Dim GrFirstPenWidth As Variant
    GrFirstPenWidth = GrFirst.Properties("PenWidth")
    Gr.Properties("PenWidth") = GrFirstPenWidth

Dim BrStyle$, BrColor As Long
    BrStyle = GrFirst.Properties("BrushStyle")
    BrColor = GrFirst.Properties("BrushColor")
    If BrStyle <> NONETYPE Then
        Gr.Properties("BrushStyle") = BrStyle
        Gr.Properties("BrushColor") = BrColor
        Gr.Properties("BrushColor") = GrFirstBrushColor
    Else
        Gr.Properties("BrushStyle") = ""
    End If
Dim Res%
    ResID(ResNum) = Gr.ID
    ResNum = ResNum + 1

    hGraphic = TCWGraphicAt(hDrawing, Gr.Index)
'    Res = TCWUndoRecordAddGraphic(hDrawing, hGraphic) '!!!!!!!!!!!!
    Set Gr = Nothing

Dim hMatrFirst As Long, hMatrSecond As Long
Dim hGrFirst As Long, hGrSecond As Long
    hGrFirst = TCWGraphicAt(hDrawing, GrFirst.Index)
    hMatrFirst = GraphicGetMatrix(hGrFirst)
Dim Res1 As Boolean
    Res1 = GraphicSetMatrix(hGraphic, hMatrFirst)

    Set Vers = Nothing
    Set GrHatch = Nothing
    Set GrChild = Nothing
    Set GrGroup = Nothing

'    Vi.Refresh

End Function

Private Function HorizontalIntersectionOld(Con() As ContGeo, Ncont As Long, iExt As Long)
Dim HInt(100) As HorizInt
Dim HIntMax As HorizInt
Dim i As Long, j As Long, k As Long, m As Long, n As Long, jMin As Long
Dim y#, xMin#, xMax#, xj#, yj#, x0#, y0#, x1#, y1#
Dim yMin() As Double
ReDim yMin(Ncont)
Dim AddLine(100) As ContGeo
Dim ContRes As ContGeo
Dim NumAddLine As Long
    NumAddLine = -1
    If Ncont = 0 Then
        ContRes = Con(0)
        GoTo RRR
    End If

    For i = 0 To Ncont
        Con(i).TakePart = False
        Con(i).Closed = True
        xMin = 10000000
        For j = 0 To Con(i).NVer - 2
            xj = Con(i).xVer(j)
            yj = Con(i).yVer(j)
            If xj < xMin Then
                xMin = xj
                yMin(i) = yj
                jMin = j
            End If
            If Abs(Con(i).yVer(jMin) - Con(i).yVer(jMin + 1)) > 100 * Eps Then
                yMin(i) = (Con(i).yVer(jMin) + Con(i).yVer(jMin + 1)) / 2
            Else
                If jMin = 0 Then
                    yMin(i) = (Con(i).yVer(0) + Con(i).yVer(Con(i).NVer - 2)) / 2
                Else
                    yMin(i) = (Con(i).yVer(jMin) + Con(i).yVer(jMin - 1)) / 2
                End If
            End If
        Next j
    Next i

Dim ExtInt(100) As HorizInt
    For n = 0 To Ncont
        If n = iExt Then GoTo L1
        y = yMin(n)
        k = -1
        k = AllPointInter(Con(iExt), y, ExtInt)     '?????????????????
        For i = 0 To k                              '?????????????????
            HInt(i).Ncont = iExt                    '?????????????????
            HInt(i).xInt = ExtInt(i).xInt           '?????????????????
            HInt(i).yInt = y                        '?????????????????
        Next i                                      '?????????????????
        For i = 0 To Ncont
            If n = iExt Then GoTo LL1               '?????????????????
'            If BiPointInter(Con(i), y, xMin, xMax) > 0 Then
'                k = k + 1
'                HInt(k).Ncont = i
'                HInt(k).xInt = xMin
'                HInt(k).yInt = y
'                k = k + 1
'                HInt(k).Ncont = i
'                HInt(k).xInt = xMax
'                HInt(k).yInt = y
'            End If

            m = AllPointInter(Con(i), y, ExtInt)
            If m > -1 Then
                For j = 0 To m
                    k = k + 1
                    HInt(k).Ncont = i
                    HInt(k).xInt = ExtInt(j).xInt
                    HInt(k).yInt = y
                Next j
            End If
LL1:                                                '?????????????????
        Next i

        For i = k To 1 Step -1
            xMax = -1000000
            For j = 0 To i
                If HInt(j).xInt > xMax Then
                    xMax = HInt(j).xInt
                    HIntMax = HInt(j)
                    m = j
                End If
            Next j
            HInt(m) = HInt(i)
            HInt(i) = HIntMax
        Next i

        For i = 1 To k - 1
            If HInt(i).Ncont = iExt Then GoTo LLL1          '????????????????????
            If Con(HInt(i).Ncont).TakePart = False Then
                x0 = HInt(i - 1).xInt
                y0 = HInt(i - 1).yInt
                x1 = HInt(i).xInt
                y1 = HInt(i).yInt
                NumAddLine = NumAddLine + 1
ReDim AddLine(NumAddLine).xVer(2)
ReDim AddLine(NumAddLine).yVer(2)
                AddLine(NumAddLine).NVer = 2
                AddLine(NumAddLine).xVer(0) = x0
                AddLine(NumAddLine).yVer(0) = y0
                AddLine(NumAddLine).xVer(1) = x1
                AddLine(NumAddLine).yVer(1) = y1
                AddLine(NumAddLine).Closed = False
'Set Gr = Grs.AddLineSingle(x0, y0, 0, x1, y1, 0)
'Gr.Properties.Item("PenColor").Value = RGB(255, 0, 0)
'Gr.Properties.Item("PenWidth").Value = 0.03
'Vi.Refresh
'MsgBox ("QQQQQ")
'Gr.Deleted = True
                Con(HInt(i).Ncont).TakePart = True

            End If
LLL1:                                                       '????????????????????
        Next i
L1:
    Next n

    For i = 0 To NumAddLine
        Con(Ncont + i + 1) = AddLine(i)
    Next i
    For i = 0 To Ncont + NumAddLine + 1
        Con(i).TakePart = False
    Next i

Dim Vers As Vertices
Dim Ver As Vertex
Dim iInt As Long, jInt As Long
Dim xj1#, yj1#
Dim xMaxInt#, yMaxInt#, yMinInt#
    xMaxInt = -1000000
    yMaxInt = -1000000
    yMinInt = 1000000

    For i = 0 To Ncont
        If i <> iExt And Con(i).NVer > 2 Then
            For j = 0 To Con(i).NVer - 1
                xj = Con(i).xVer(j)
                If xj > xMaxInt Then
                    xMaxInt = xj
                    yMaxInt = Con(i).yVer(j)
                    iInt = i
                    jInt = j
                End If
            Next j
        End If
    Next i
Dim yma#, ymi#
    yma = -100000000
    ymi = 100000000
    For j = 0 To Con(iInt).NVer - 1
        yj = Con(iInt).yVer(j)
        If yj > yma Then yma = yj
        If yj < ymi Then ymi = yj
    Next j

    If yma - yMaxInt > 100 * Eps Then
        xj = xMaxInt + 100 * Eps
        yj = yMaxInt + 100 * Eps
    Else
        xj = xMaxInt + 100 * Eps
        yj = yMaxInt - 100 * Eps
    End If
'GoTo LLL
'MsgBox ("xmaxInt=" & CStr(xMaxInt) & "  ymaxInt=" & CStr(yMaxInt))
'    If jInt = 0 Or jInt = Con(iInt).NVer - 1 Then
'        x0 = Con(iInt).xVer(Con(iInt).NVer - 2)
'        y0 = Con(iInt).yVer(Con(iInt).NVer - 2)
'        x1 = Con(iInt).xVer(1)
'        y1 = Con(iInt).yVer(1)
'    Else
'        x0 = Con(iInt).xVer(jInt - 1)
'        y0 = Con(iInt).yVer(jInt - 1)
'        x1 = Con(iInt).xVer(jInt + 1)
'        y1 = Con(iInt).yVer(jInt + 1)
'    End If
'Dim xMid1#, yMid1#, xMid2#, yMid2#
'    xMid1 = (xMaxInt + x0) / 2
'    yMid1 = (yMaxInt + y0) / 2
'    xMid2 = (xMaxInt + x1) / 2
'    yMid2 = (yMaxInt + y1) / 2
'    If xMid1 > xMid2 Then
'        xj = xMid1 + 1000 * Eps
'        yj = yMid1
'    Else
'        xj = xMid2 + 1000 * Eps
'        yj = yMid2
'    End If
'   xj = xMaxInt + 0.001
'   yj = yMaxInt + 0.001
'LLL:

'Set Gr = Grs.AddSquare(xj, yj, 0)
'Vi.Refresh
'MsgBox ("#########")

    Call InitSSS(Con, Ncont + NumAddLine + 1, xj, yj, ContRes)
RRR:

    Set Gr = Grs.Add(11) '??????????????
    Gr.Properties("Thickness") = 0
    Set Vers = Gr.Vertices
    Set Ver = Vers.Add(ContRes.xVer(0), ContRes.yVer(0), 0) '???
    For j = 1 To ContRes.NVer - 1
        xj = ContRes.xVer(j)
        yj = ContRes.yVer(j)
        k = j - 1
        xj1 = ContRes.xVer(k)
        yj1 = ContRes.yVer(k)
        Set Ver = Vers.Add(xj, yj, 0)
        Gr.Vertices.Item(0).PenDown = True

        For i = 0 To NumAddLine
            x0 = AddLine(i).xVer(0)
            y0 = AddLine(i).yVer(0)
            x1 = AddLine(i).xVer(1)
            y1 = AddLine(i).yVer(1)
            If Abs(xj - x0) < Eps And Abs(yj - y0) < Eps And Abs(xj1 - x1) < Eps And Abs(yj1 - y1) < Eps Then
                Gr.Vertices.Item(j).PenDown = False
                GoTo L3
            End If
            If Abs(xj - x1) < Eps And Abs(yj - y1) < Eps And Abs(xj1 - x0) < Eps And Abs(yj1 - y0) < Eps Then
                Gr.Vertices.Item(j).PenDown = False
                GoTo L3
            End If
        Next i
        Gr.Vertices.Item(j).PenDown = True

L3:
'Gr.Properties.Item("PenColor").Value = RGB(255, 0, 0)
'Gr.Properties.Item("PenWidth").Value = 0.05
'Vi.Refresh
'MsgBox ("QQQQQ")

    Next j

    Gr.Closed = True
    Gr.Properties("PenColor") = GrFirstPenColor
    Gr.Properties("PenStyle") = GrFirstPenStyle
Dim GrFirstPenWidth As Variant
    GrFirstPenWidth = GrFirst.Properties("PenWidth")
    Gr.Properties("PenWidth") = GrFirstPenWidth

Dim BrStyle$, BrColor As Long
    BrStyle = GrFirst.Properties("BrushStyle")
    BrColor = GrFirst.Properties("BrushColor")
    If BrStyle <> NONETYPE Then
        Gr.Properties("BrushStyle") = BrStyle
        Gr.Properties("BrushColor") = BrColor
        Gr.Properties("BrushColor") = GrFirstBrushColor
    End If
Dim Res%
    hGraphic = TCWGraphicAt(hDrawing, Gr.Index)
    Res = TCWUndoRecordAddGraphic(hDrawing, hGraphic) '!!!!!!!!!!!!
    Set Gr = Nothing

Dim hMatrFirst As Long, hMatrSecond As Long
Dim hGrFirst As Long, hGrSecond As Long
    hGrFirst = TCWGraphicAt(hDrawing, GrFirst.Index)
    hMatrFirst = GraphicGetMatrix(hGrFirst)
Dim Res1 As Boolean
    Res1 = GraphicSetMatrix(hGraphic, hMatrFirst)

'    Vi.Refresh
    Set Ver = Nothing
    Set Vers = Nothing
End Function

Private Function InitSSS(Con() As ContGeo, nG As Long, x#, y#, CRes As ContGeo) As Boolean
On Error GoTo ErrHand

Dim Rot% ' Initial direction of going  =1 - against clockwise  = -1 - clockwise
    Rot = 1
Dim nVRes As Long
    nVRes = 0 ' Resulting count of
Dim i As Long, j As Long
Dim nV As Long
Dim xMax#, xMin#, yMax#, yMin#
Dim kWork% ' Number of work contour
Dim jInit% ' Initial vertex
Dim dir%
    dir = 1
    xMax = -100000000
    xMin = 100000000
    yMax = -100000000
    yMin = 100000000
Dim xx#, yy#
Dim xi#, yi#, xi1#, yi1#
Dim k%
Dim k1% ' counter intersecting contours
Dim Dist(100) As DDD
Dim BetaMin(100) As TTT

Dim xj#, yj#, xj1#, yj1#
Dim a#, b#
Dim l#
Dim dx#, dxx#, dy#, dyy#

Dim xBeg#, yBeg#, xEnd#, yEnd#, xEnd1#, yEnd1#
Dim Pr%
Dim NewCont As Boolean
    NewCont = True
    Pr = 0
    InitSSS = True
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' define left nearest object to  MouseClick
    dir = 1
Dim lxMin#, dxMin#, xInt#, yInt#, xintMin#
    dxMin = 10000000

    For i = 0 To nG
        If Con(i).TakePart = True Then GoTo TTT1
        nV = Con(i).NVer
        For j = 0 To nV - 2
            xj = Con(i).xVer(j)
            yj = Con(i).yVer(j)
            xj1 = Con(i).xVer(j + 1)
            yj1 = Con(i).yVer(j + 1)
            If yj > y And yj1 > y Then GoTo TTT
            If yj < y And yj1 < y Then GoTo TTT
            If Abs(yj1 - yj) > Eps Then
                xInt = xj + (xj1 - xj) / (yj1 - yj) * (y - yj)
                If PointIntoSegmentiInter(xj, yj, xj1, yj1, xInt, y) = 1 And x - xInt > 0 Then
                    If x - xInt < dxMin Then
                        dxMin = x - xInt
                        xintMin = xInt
                        jInit = j
                        kWork = i
                    End If
                End If
            End If
TTT:
        Next j
TTT1:
    Next i

Dim ContWork As ContGeo
    ContWork = Con(kWork)
' define Dir for initial segment clockwise

    xBeg = ContWork.xVer(jInit)
    yBeg = ContWork.yVer(jInit)
    xEnd = ContWork.xVer(jInit + 1)
    yEnd = ContWork.yVer(jInit + 1)
    If yEnd > yBeg Then
        dir = 1
    Else
        dir = -1
        jInit = jInit + 1
        xBeg = ContWork.xVer(jInit)
        yBeg = ContWork.yVer(jInit)
        xEnd = ContWork.xVer(jInit + dir)
        yEnd = ContWork.yVer(jInit + dir)
    End If
'MsgBox ("SSSSxBeg=" & CStr(xBeg) & " yBeg=" & CStr(yBeg) & " xEnd=" & CStr(xEnd) & " yEnd=" & CStr(yEnd))

' Define initial point of inital segment
Dim a1#, b1#, d1#, aj#, bj#, dj#
Dim dl#
    a1 = -(yEnd - yBeg)
    b1 = xEnd - xBeg
    d1 = a1 * xBeg + b1 * yBeg
'*********************************************************************************
'*********************************************************************************
' Selecte all Objects which are inside in circle with Radius=l/2 and Center in middle
' of the segment (xBeg,yBeg) - (xIntMin,y)

    l = Sqr((xintMin - xBeg) * (xintMin - xBeg) + (y - yBeg) * (y - yBeg))
    If l < Eps Then GoTo WWW
    dx = xintMin - xBeg
    dy = y - yBeg
    xx = (xintMin + xBeg) / 2
    yy = (y + yBeg) / 2

'*********************************************************************************
'*********************************************************************************
Dim cosa#, sina#, xLocj#, yLocj#, xLocj1#, yLocj1#
    cosa = dx / l
    sina = dy / l
    k1 = 0
    For k = 0 To nG
'        If ContSel(k).GrInd = kWork Then GoTo LL
        For j = 0 To Con(k).NVer - 2
            xj = Con(k).xVer(j)
            yj = Con(k).yVer(j)
            xj1 = Con(k).xVer(j + 1)
            yj1 = Con(k).yVer(j + 1)
'**************************************************************************
            yLocj = (yj - yBeg) * cosa - (xj - xBeg) * sina
            xLocj = (yj - yBeg) * sina + (xj - xBeg) * cosa
            yLocj1 = (yj1 - yBeg) * cosa - (xj1 - xBeg) * sina
            xLocj1 = (yj1 - yBeg) * sina + (xj1 - xBeg) * cosa
            If yLocj > Eps And yLocj1 > Eps Then GoTo LLL
            If yLocj < -Eps And yLocj1 < -Eps Then GoTo LLL
            If Abs(yLocj - yLocj1) < Eps Then GoTo LLL
            If xLocj - l > Eps And xLocj1 - l > Eps Then GoTo LLL
            If xLocj < -Eps And xLocj1 < -Eps Then GoTo LLL

'***********************************************************************
            aj = -(yj1 - yj)
            bj = xj1 - xj
            dj = aj * xj + bj * yj
            Call SysLine(a1, b1, d1, aj, bj, dj, xInt, yInt)
            If PointIntoSegmentiInter(xBeg, yBeg, xintMin, y, xInt, yInt) = 1 And PointIntoSegmentjInter(xj, yj, xj1, yj1, xInt, yInt) = 1 Then
                Dist(k1).LL = Sqr((xInt - xBeg) * (xInt - xBeg) + (yInt - yBeg) * (yInt - yBeg))
                Dist(k1).xx = xInt
                Dist(k1).yy = yInt
                k1 = k1 + 1

            End If
LLL:
        Next j
LL:
    Next k
Dim lMin#, l0#
Dim imin%
Dim pr0%, pp%
    pr0 = 0
    pp = 0
    lMin = 10000000
    l0 = Sqr((xintMin - xBeg) * (xintMin - xBeg) + (y - yBeg) * (y - yBeg))
    For i = 0 To k1 - 1
        xInt = Dist(i).xx
        yInt = Dist(i).yy
        If PointIntoSegmenti(xBeg, yBeg, xintMin, y, xInt, yInt) = 1 Then
            l = l0 - Dist(i).LL
            If l < lMin Then
                lMin = l
                imin = i
                pp = 1
            End If
        End If
    Next i
    If k1 > 0 And pp = 1 Then
        xBeg = Dist(imin).xx
        yBeg = Dist(imin).yy
        l0 = lMin
        pr0 = 1
    End If
WWW:
'MsgBox ("xBeg=" & CStr(xBeg) & " yBeg=" & CStr(yBeg))
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Dim xCon(5000) As Double
Dim yCon(5000) As Double

' Initial point of result contour
    nVRes = 0
    xCon(nVRes) = xBeg
    yCon(nVRes) = yBeg

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'Set Gr = Grs.AddCircle(xBeg, yBeg, 0)
'Gr.Properties.Item("PenColor").Value = RGB(0, 255, 0)
'Vi.Refresh
'MsgBox ("Initial Point")
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
LBEG:
    If dir = -1 And jInit = 0 Then jInit = ContWork.NVer - 1
    If dir = 1 And jInit = ContWork.NVer - 1 Then jInit = 0
'MsgBox ("LBegin jInit = " & CStr(jInit) & "  Dir = " & CStr(dir))
    If Pr = 0 Then
        xi = xBeg
        yi = yBeg
    Else
        xi = ContWork.xVer(jInit)
        yi = ContWork.yVer(jInit)
    End If
    If Pr <> 0 Then
        nVRes = nVRes + 1
        If nVRes = 4000 Then
            InitSSS = False
            Exit Function
        End If
        xCon(nVRes) = xi
        yCon(nVRes) = yi
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' Set Gr = Grs.AddCircle(xi, yi, 0)
'Gr.Properties.Item("PenColor").Value = RGB(0, 255, 0)
' Vi.Refresh
' MsgBox ("New Point")
' Gr.Deleted = True
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    End If
    xi1 = ContWork.xVer(jInit + dir)
    yi1 = ContWork.yVer(jInit + dir)
    If Abs(xi - xBeg) < Eps And Abs(yi - yBeg) < Eps And Pr <> 0 Then
ReDim CRes.xVer(nVRes + 1)
ReDim CRes.yVer(nVRes + 1)
        CRes.NVer = nVRes + 1
        For j = 0 To nVRes
            CRes.xVer(j) = xCon(j)
            CRes.yVer(j) = yCon(j)
        Next j
        Exit Function
    End If
    Pr = 1
' Defining the number of contours intersecting with curent segment
LBEG1:
'MsgBox ("xi=" & CStr(xi) & " yi=" & CStr(yi) & "  xi1=" & CStr(xi1) & " yi1=" & CStr(yi1))
    k1 = 0
    a1 = -(yi1 - yi)
    b1 = xi1 - xi
    d1 = a1 * xi + b1 * yi

    l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
    dx = (xi1 - xi)
    dy = (yi1 - yi)
    If l < Eps Then
        k1 = 0
        GoTo SS1
    End If

    cosa = dx / l
    sina = dy / l
'MsgBox ("xi=" & CStr(xi) & " yi=" & CStr(yi) & "  xi1=" & CStr(xi1) & " yi1=" & CStr(yi1))

    For k = 0 To nG
'        If k = kWork Then GoTo L1      ??????????????????????
        For j = 0 To Con(k).NVer - 2
            xj = Con(k).xVer(j)
            yj = Con(k).yVer(j)
            xj1 = Con(k).xVer(j + 1)
            yj1 = Con(k).yVer(j + 1)
'MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj) & "  xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))

            If Abs(xj - xj1) < Eps And Abs(yj - yj1) < Eps Then GoTo L4

'**************************************************************************
            yLocj = (yj - yi) * cosa - (xj - xi) * sina
            xLocj = (yj - yi) * sina + (xj - xi) * cosa
            yLocj1 = (yj1 - yi) * cosa - (xj1 - xi) * sina
            xLocj1 = (yj1 - yi) * sina + (xj1 - xi) * cosa
            If k = kWork And Abs(yLocj) < Eps And Abs(yLocj1) < Eps Then GoTo L4

            If yLocj > 10 * Eps And yLocj1 > 10 * Eps Then GoTo L4
            If yLocj < -10 * Eps And yLocj1 < -10 * Eps Then GoTo L4
            If Abs(yLocj - yLocj1) < Eps And Abs(yLocj) > Eps Then GoTo L4
            If xLocj - l > 10 * Eps And xLocj1 - l > 10 * Eps Then GoTo L4
            If xLocj < -10 * Eps And xLocj1 < -10 * Eps Then GoTo L4
'***********************************************************************
'MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj) & "  xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))

' If two lines are coincident
            If Abs(yLocj) < Eps And Abs(yLocj1) < Eps Then
          ' if work segment is inside oter segment
                If xLocj < Eps And xLocj1 - l > 10 * Eps And k <> kWork Then
                    jInit = j
                    dir = 1
                    xi1 = xj1
                    yj1 = yj1
                    kWork = k
                    ContWork = Con(k)
                    NewCont = True
                    GoTo LBEG1
                End If
                If xLocj1 < Eps And xLocj - l > 10 * Eps And k <> kWork Then
                    jInit = j + 1
                    dir = -1
                    xi1 = xj
                    yi1 = yj
                    kWork = k
                    ContWork = Con(k)
                    NewCont = True
                    GoTo LBEG1
                End If
            ' If Work segment and other segment coincident in Ended points
                If Abs(xLocj - l) < Eps And xLocj1 - l > 10 * Eps And k <> kWork Then
'MsgBox ("111111111")
                    Dist(k1).LL = l
                    Dist(k1).xx = xi1
                    Dist(k1).yy = yi1
                    Dist(k1).jj = j
                    Dist(k1).jj1 = j + 1
                    Dist(k1).kk = k
                    k1 = k1 + 1 'Set Gr = Grs.AddCross(xint, yint, 0)
                    GoTo L4
                End If
                If Abs(xLocj1 - l) < Eps And xLocj - l > 10 * Eps And k <> kWork Then

                   Dist(k1).LL = l
                    Dist(k1).xx = xi1
                    Dist(k1).yy = yi1
                    Dist(k1).jj = j
                    Dist(k1).jj1 = j + 1
                    Dist(k1).kk = k
                    k1 = k1 + 1 'Set Gr = Grs.AddCross(xint, yint, 0)
'MsgBox ("22222222" & " j=" & CStr(j))
' MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj) & "  xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))
'MsgBox ("xi1=" & CStr(xi1) & " yi1=" & CStr(yi1) & " k1=" & CStr(k1))

                    GoTo L4
                End If
            End If
            If Abs(yLocj) < Eps And Abs(yLocj1) < Eps Then GoTo L4

'MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj) & "  xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))
            aj = -(yj1 - yj)
            bj = xj1 - xj
            dj = aj * xj + bj * yj
            Call SysLine(a1, b1, d1, aj, bj, dj, xInt, yInt)
'MsgBox ("xInt=" & CStr(xInt) & " yInt=" & CStr(yInt))
'Set Gr = Grs.AddCross(xInt, yInt, 0)
'Vi.Refresh
'MsgBox ("Point intersection k1=" & CStr(k1))
'MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj) & "  xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))
'MsgBox ("xInt=" & CStr(xInt) & " yInt=" & CStr(yInt))

            If Abs(xInt - xi) < Eps And Abs(yInt - yi) < Eps Then GoTo L4
            If PointIntoSegmentiInter(xi, yi, xi1, yi1, xInt, yInt) = 1 And PointIntoSegmentjInter(xj, yj, xj1, yj1, xInt, yInt) = 1 Then
                Dist(k1).LL = Sqr((xInt - xi) * (xInt - xi) + (yInt - yi) * (yInt - yi))
                Dist(k1).xx = xInt
                Dist(k1).yy = yInt
                Dist(k1).jj = j
                Dist(k1).jj1 = j + 1
                Dist(k1).kk = k
                k1 = k1 + 1 'Set Gr = Grs.AddCross(xint, yint, 0)
'Set Gr = Grs.AddCross(xInt, yInt, 0)
'Vi.Refresh
'MsgBox ("Point intersection k1=" & CStr(k1))
'MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj) & "  xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))
'MsgBox ("xInt=" & CStr(xInt) & " yInt=" & CStr(yInt))

            End If
L4:
        Next j
L1:
    Next k
SS1:
Dim alfaj#, alfai#

Dim jj%, kk%, pr1%, pr2%, prr%
    pr1 = 0
    pr2 = 0
    prr = 0

'MsgBox (" Finish k1 = " & CStr(k1))
'MsgBox ("Dir Rot = " & CStr(Rot))
 '   If k1 = 1 And Dist(0).kk = kWork And Abs(ContWork.xVer(jInit + dir) - Dist(0).xx) < Eps And Abs(ContWork.yVer(jInit + dir) - Dist(0).yy) < Eps Then k1 = 0
    If k1 = 0 Then
'checking intersection contour- kWork with other contouts in point - i+1
Dim xii#, yii#
Dim yLoc#, xLoc#
Dim jj1%
Dim xxi1#, yyi1#
Dim alfaj1#
        If dir = 1 And jInit = ContWork.NVer - 1 Then
            If ContWork.Closed = True Then jInit = 0
        End If
        If dir = -1 And jInit = 0 Then
            If ContWork.Closed = True Then jInit = ContWork.NVer - 1
        End If

        jInit = jInit + dir
        If dir = 1 And jInit = ContWork.NVer - 1 Then
                If ContWork.Closed = True Then jInit = 0
        End If
        If dir = -1 And jInit = 0 Then
            If ContWork.Closed = True Then jInit = ContWork.NVer - 1
        End If
        If dir = 1 And jInit = ContWork.NVer - 1 Then
            If ContWork.Closed = False Then
                dir = -1
'                MsgBox ("Created contour is not closed")
'                Exit Function
            End If
        End If
        If dir = -1 And jInit = 0 Then
            If ContWork.Closed = False Then
                dir = 1
'                MsgBox ("Created contour is not closed")
'                Exit Function
            End If
        End If
        GoTo LBEG
    End If   ' k1=0

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

' if k1>0 There are same intersections current segment witt other graphics
'MsgBox (">>>>>>k1=" & CStr(k1))
Dim kmin%
    lMin = 10000000
    For k = 0 To k1 - 1
        If lMin > Dist(k).LL Then
            lMin = Dist(k).LL
            kmin = k
        End If
    Next k
Dim k2%, Mi(100) As Long
    k2 = 0
' Define number graphics intersecting with current segment at nearest point
    For k = 0 To k1 - 1
        If Abs(Dist(k).LL - lMin) < Eps Then
            Mi(k2) = k
            k2 = k2 + 1
        End If
    Next k
'MsgBox ("k2=" & CStr(k2) & "  dir=" & CStr(dir) & " jInit=" & CStr(jInit))

    l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
    cosa = (xi1 - xi) / l
    sina = (yi1 - yi) / l

Dim j1%

 ' There are intersections current segment with oter graphics
 Dim xinter#, yinter#, beta1#, beta2#, xj_1#, yj_1#
    For k = 0 To k2 - 1
        xinter = Dist(Mi(k)).xx
        yinter = Dist(Mi(k)).yy
        j = Dist(Mi(k)).jj
        k1 = Dist(Mi(k)).kk
        xj = Con(k1).xVer(j)
        yj = Con(k1).yVer(j)
        xj1 = Con(k1).xVer(j + 1)
        yj1 = Con(k1).yVer(j + 1)
        ' If point of intersection concidences with vertex - j
        If Abs(xinter - xj) < Eps And Abs(yinter - yj) < Eps Then
            If j = 0 Then
                If Con(k1).Closed = False Then
                    beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj1, yj1)
'MsgBox ("Beta1=" & CStr(beta1 * 180 / Pi))
                    BetaMin(k).Bet = beta1
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j
                    BetaMin(k).ddir = 1
                Else
                    beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj1, yj1)
                    xj_1 = Con(k1).xVer(Con(k1).NVer - 2)
                    yj_1 = Con(k1).yVer(Con(k1).NVer - 2)
                    beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                    BetaMin(k).Bet = beta1
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j
                    BetaMin(k).ddir = 1
                End If
            Else
                beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj1, yj1)
                xj_1 = Con(k1).xVer(j - 1)
                yj_1 = Con(k1).yVer(j - 1)
                beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                If beta1 > beta2 Then
                    BetaMin(k).Bet = beta2
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j
                    BetaMin(k).ddir = -1
                Else
                    BetaMin(k).Bet = beta1
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j
                    BetaMin(k).ddir = 1
                End If
            End If
            GoTo GGG
        End If
        ' If point of intersection concidences with vertex - j+1
        If Abs(xinter - xj1) < Eps And Abs(yinter - yj1) < Eps Then
'MsgBox (" inter = xj1" & " j+1=" & CStr(j + 1) & "  k1=" & CStr(k1) & "  Cont(k1).NVer - 1=" & CStr(Cont(k1).NVer - 1))
            If j + 1 = Con(k1).NVer - 1 Then
                If Con(k1).Closed = False Then
                    beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
                    BetaMin(k).Bet = beta1
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j + 1
                    BetaMin(k).ddir = -1
                Else
                    beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
                    xj_1 = Con(k1).xVer(1)
                    yj_1 = Con(k1).yVer(1)
                    beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                    If beta1 > beta2 Then
                        BetaMin(k).Bet = beta2
                        BetaMin(k).kk = k1
                        BetaMin(k).jInit = 0
                        BetaMin(k).ddir = 1
                    Else
                        BetaMin(k).Bet = beta1
                        BetaMin(k).kk = k1
                        BetaMin(k).jInit = j + 1
                        BetaMin(k).ddir = -1
                    End If
                End If
            Else
                beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
                xj_1 = Con(k1).xVer(j + 2)
                yj_1 = Con(k1).yVer(j + 2)
                beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                BetaMin(k).Bet = beta1
                BetaMin(k).kk = k1
                BetaMin(k).jInit = j + 1
                BetaMin(k).ddir = -1
            End If
            GoTo GGG
        End If
'MsgBox (" Point is Internal")
        ' If point of intersection is internal point of segment j - j+1
        beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
        beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj1, yj1)
        If beta1 > beta2 Then
            BetaMin(k).Bet = beta2
            BetaMin(k).kk = k1
            BetaMin(k).jInit = j
            BetaMin(k).ddir = 1
        Else
            BetaMin(k).Bet = beta1
            BetaMin(k).kk = k1
            BetaMin(k).jInit = j + 1
            BetaMin(k).ddir = -1
        End If
GGG:
'MsgBox (" k=" & CStr(k) & "  LocBet=" & CStr(BetaMin(k).Bet * 180 / Pi))

        ' Conditions for current graphic -kWork
Dim BetaWork#
        If Abs(xinter - xi1) < Eps And Abs(yinter - yi1) < Eps Then
'MsgBox ("End point" & " dir=" & CStr(dir) & " jInit + dir=" & CStr(jInit + dir))
            If ContWork.Closed = False And dir > 0 And jInit + dir = ContWork.NVer - 1 Then
                BetaMin(k2).Bet = 2 * Pi
                BetaWork = 2 * Pi
                GoTo UU1
            End If
            If ContWork.Closed = False And dir < 0 And jInit + dir = 0 Then
                BetaMin(k2).Bet = 2 * Pi
                BetaWork = 2 * Pi
                GoTo UU1
            End If
            If ContWork.Closed = True And dir > 0 And jInit + dir = ContWork.NVer - 1 Then
                xj = ContWork.xVer(1)
                yj = ContWork.yVer(1)
                BetaMin(k2).jInit = 0
                GoTo UUU
            End If
            If ContWork.Closed = True And dir < 0 And jInit + dir = 0 Then
                xj = ContWork.xVer(ContWork.NVer - 2)
                yj = ContWork.yVer(ContWork.NVer - 2)
                BetaMin(k2).jInit = ContWork.NVer - 1
                GoTo UUU
            End If
            xj = ContWork.xVer(jInit + 2 * dir)
            yj = ContWork.yVer(jInit + 2 * dir)
            BetaMin(k2).jInit = jInit + dir

UUU:
            beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
            BetaMin(k2).Bet = beta1
            BetaWork = beta1
            BetaMin(k2).kk = -100
            BetaMin(k2).ddir = dir
UU1:
        Else
            BetaMin(k2).Bet = 0
            BetaWork = 0
            BetaMin(k2).jInit = jInit
            BetaMin(k2).kk = -100
            BetaMin(k2).ddir = dir
        End If
'MsgBox (" KKKK LocBet=" & CStr(BetaMin(k2).Bet * 180 / Pi))
    Next k

Dim BeMin#
    BeMin = 2 * Pi
    For k = 0 To k2
        If BetaMin(k).Bet < BeMin And Abs(BetaMin(k).Bet + Pi) > 0.01 And Abs(BetaMin(k).Bet + 2 * Pi) > 0.01 Then
            kmin = k
            BeMin = BetaMin(k).Bet
        End If
    Next k
'MsgBox ("BeMin=" & CStr(BeMin * 180 / Pi))
    xi = xinter
    yi = yinter
    If BetaMin(kmin).kk <> -100 Then  'And Abs(BeMin - BetaWork) > 0.001
        xi1 = Con(BetaMin(kmin).kk).xVer(BetaMin(kmin).jInit + BetaMin(kmin).ddir)
        yi1 = Con(BetaMin(kmin).kk).yVer(BetaMin(kmin).jInit + BetaMin(kmin).ddir)
        jInit = BetaMin(kmin).jInit
        dir = BetaMin(kmin).ddir
    Else
        xi1 = ContWork.xVer(BetaMin(kmin).jInit + BetaMin(kmin).ddir)
        yi1 = ContWork.yVer(BetaMin(kmin).jInit + BetaMin(kmin).ddir)
        jInit = BetaMin(kmin).jInit
        dir = BetaMin(kmin).ddir
    End If
    nVRes = nVRes + 1
    If nVRes = 4000 Then
        InitSSS = False
        Exit Function
    End If

    xCon(nVRes) = xi
    yCon(nVRes) = yi

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Set Gr = Grs.AddStar(xi, yi, 0)
'Gr.Properties.Item("PenColor").Value = RGB(0, 255, 0)
' Vi.Refresh
' MsgBox ("New Point")
' Gr.Deleted = True
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
    If Abs(xi - xBeg) < Eps And Abs(yi - yBeg) < Eps Then
ReDim CRes.xVer(nVRes + 1)
ReDim CRes.yVer(nVRes + 1)
        CRes.NVer = nVRes + 1
        For j = 0 To nVRes
            CRes.xVer(j) = xCon(j)
            CRes.yVer(j) = yCon(j)
        Next j
        Exit Function
    End If
    If BetaMin(kmin).kk <> -100 Then
        kWork = BetaMin(kmin).kk
        ContWork = Con(BetaMin(kmin).kk)
        NewCont = True
    End If

    GoTo LBEG1

    Exit Function

ErrHand:
'    MsgBox ("Error InitSSS")
'    MsgBox Err.Description
    InitSSS = False

End Function

Private Function ExplodeWithUnVisible(GrExp As Graphic, GrSet As GraphicSet)
Dim nV As Long, i As Long, j As Long, iBeg As Long
Dim xBeg#, yBeg#, xi#, yi#
Dim GrVer As GrWithUnVis
Dim Vers As Vertices
Dim Ver As Vertex
Dim GrE As Graphic
Dim VerE As Vertex
    Set Vers = GrExp.Vertices
    nV = Vers.Count
ReDim GrVer.xVer(nV + 1)
ReDim GrVer.yVer(nV + 1)
ReDim GrVer.Pen(nV + 1)
ReDim GrVer.TakePart(nV + 1)
Dim Pr As Boolean
    Pr = False
    For i = 0 To nV - 1
        Set Ver = Vers.Item(i)
        GrVer.xVer(i) = Ver.x
        GrVer.yVer(i) = Ver.y
        GrVer.Pen(i) = GrExp.Vertices.Item(i).PenDown
        GrVer.TakePart(i) = False
    Next i
LBEG1:
    GrVer.Pen(nV) = True
    For i = 0 To nV - 1
        If GrVer.TakePart(i) = False Then
            iBeg = 0
            Set GrE = GrSet.Add(11)
 '           Set GrE = Grs.Add(11)
            Pr = False
            GoTo LBEG
        End If
    Next i
        GoTo LEND

LBEG:
    For i = iBeg To nV - 1
        If GrVer.TakePart(i) = True Then GoTo L1
        If GrVer.Pen(i + 1) = True Then
            Set VerE = GrE.Vertices.Add(GrVer.xVer(i), GrVer.yVer(i), 0)
            GrVer.TakePart(i) = True
            If Pr = False Then
                xBeg = GrVer.xVer(i)
                yBeg = GrVer.yVer(i)
                Pr = True
            Else
                If Abs(xBeg - GrVer.xVer(i)) < Eps And Abs(yBeg - GrVer.yVer(i)) < Eps Then
                    GoTo LBEG1:
                End If
            End If
        Else
            If GrVer.Pen(i) = True Then
                Set VerE = GrE.Vertices.Add(GrVer.xVer(i), GrVer.yVer(i), 0)
                GrVer.TakePart(i) = True
                If Pr = False Then
                    xBeg = GrVer.xVer(i)
                    yBeg = GrVer.yVer(i)
                    Pr = True
                Else
                    If Abs(xBeg - GrVer.xVer(i)) < Eps And Abs(yBeg - GrVer.yVer(i)) < Eps Then
                        GoTo LBEG1:
                    End If
                End If
                xi = GrVer.xVer(i)
                yi = GrVer.yVer(i)
            End If
            For j = i + 1 To nV - 1
                If GrVer.TakePart(j) = True Then GoTo L2
                If Abs(xi - GrVer.xVer(j)) < Eps And Abs(yi - GrVer.yVer(j)) < Eps And GrVer.Pen(j) = False Then
                    iBeg = j + 1
                    GrVer.TakePart(j) = True
                    GoTo LBEG
                End If
L2:
            Next j
        End If
L1:
    Next i
LEND:
End Function

Public Function BeforeDoubleClick(WhichDrawing As Drawing, WhichView As View, WhichWindow As Window, Sel As Selection, Cancel As Boolean)
   Cancel = True
End Function

Public Function MouseUp(WhichDrawing As Drawing, WhichView As View, WhichWindow As Window, Button As ImsiMouseButton, Shift As Long, x As Long, y As Long, Cancel As Boolean)
   Cancel = True
End Function


Examples - 2D Boolean Tool - modBool2D.bas

modBool2D.bas

2D Boolean Tool Example

Attribute VB_Name = "modBool2D"
Option Explicit
Type ContGeo
    NVer As Long
    xVer() As Double
    yVer() As Double
    Loc() As String
    TakePart As Boolean
    Closed As Boolean
    Pr As Boolean
End Type
Type DDD
    LL As Double
    xx As Double
    yy As Double
    jj As Long
    jj1 As Long
    kk As Long
End Type

Type TTT
    Bet As Double
    jInit As Long
    kk As Long
    ddir As Integer
End Type
Type IntPoint
    nInt As Long
    xInt() As Double
    yInt() As Double
    iInt() As Long
    jInt() As Long
    Pr() As Boolean
End Type
Type HorizInt
    xInt As Double
    yInt As Double
    Ncont As Long
End Type
Type GrWithUnVis
    xVer() As Double
    yVer() As Double
    Pen() As Boolean
    TakePart() As Boolean
End Type

Global NotInclude() As String
Global NIncl As Long
Global objApp As Application
Global Drs As Drawings
Global Dr As Drawing
Global Gr As Graphic
Global GrDup As Graphic
Global Grs As Graphics
'Global GrSets As GraphicSets
'Global GrSet As GraphicSet
Global Vis As Views
Global Vi As View
Global Vers As Vertices
Global Gcont As Graphic
Global PicRes As PickResult
Global PicEnt As PickEntry
Global FirstID As Long
Global xClick As Double
Global yClick As Double
Global iNSel As Long
Global Result As Boolean

Global Const Eps0 = 0.0000001
Global Eps As Double
Global Const Pi = 3.14159265359
Global Operation As String
Global TryAgain As Boolean
Global GRAPHICTYPE As String
Global ARCTYPE As String
Global DATATYPE As String
Global CIRCLETYPE As String
Global TEXTTYPE As String
Global NONETYPE As String
Global INSERTTYPE As String
Global SOLIDTYPE As String
Global SURFACETYPE As String
Global SELSECONDG As String
Sub Main()
    ReDim NotInclude(7)
    NotInclude(0) = LoadResString(133) '"TEXT"
    NotInclude(1) = "TCW30POINT"
    NotInclude(2) = LoadResString(130) '"ARC"
    NotInclude(3) = "TCW25DimLin"
    NotInclude(4) = "TCW25DimDat"
    NotInclude(5) = "TCW25DimAng"
    NotInclude(6) = "TCW25DblLine"
    NIncl = 6
    iNSel = 0
End Sub


Examples - File Converter Tool - Converter.bas

Converter.bas

File Converter Tool Example

Attribute VB_Name = "modConverter"
Global ObjApp As Application
Global Drs As Drawings
Global bConversionRunned As Boolean
Global bInterupt As Boolean
Global sCaption As String
Global isSummInfo As Boolean
'Global Ftrs As Filters
Global CurCombo As Boolean
Global CurImportFilter As String
Global CurExportFilter As String

Declare Function AppGetCurrentApp Lib "DBAPI70.DLL" () As Long
Declare Function AppSetupFilter Lib "DBAPI70.DLL" (ByVal hApp As Long, ByVal ReadWrite As Boolean, ByVal ext As String, ByVal descr As String) As Boolean
Sub Main()

End Sub


Examples - File Converter Tool - Converter.cls

Converter.cls

File Converter Tool Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Converter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
'Number of tools in this server
Const NUM_TOOLS = 1
'Toggle this to test loading buttons from .Bmp/.Res
Const boolLoadFromBmp As Boolean = False
'Return a description string for this package of tools
Public Property Get Description() As String
    Description = LoadResString(101) '"TurboCAD File Converter"
End Property

'Called to perform tool function
Public Function Run(ByVal Tool As Object) As Boolean
'    Dim ObjApp As Object
    Dim objSel As Object
    Dim objGraphic As Object
    Dim strURL As String
    On Error Resume Next

    'Look for first URL property in the selection
'    Set ObjApp = Tool.Application

    Set ObjApp = Tool.Application 'GetObject("TurboCAD.Application") 'CreateObject("IMSIGX.Application")
    If ObjApp Is Nothing Then
'        MsgBox "Couldn't attach to TurboCAD.  " & Err.Description & "  Quitting."
        MsgBox LoadResString(102) & Err.Description & LoadResString(103)
        Exit Function
    End If
    Set Drs = ObjApp.Drawings
    If Drs Is Nothing Then
'        MsgBox "Bad server.  " & Err.Description & "  Quitting"
        MsgBox LoadResString(104) & Err.Description & LoadResString(103)
        Exit Function
    End If
    isSummInfo = ObjApp.Properties("PromptForSummaryInfo").Value

    ObjApp.Properties("PromptForSummaryInfo") = False
    frmConverter.Show vbModal

    ObjApp.Properties("PromptForSummaryInfo") = CLng(isSummInfo)

    Run = True
End Function

'Fill arrays with information about tools in the package
'Return the number of tools in the package
Public Function GetToolInfo(CommandNames As Variant, MenuCaptions As Variant, StatusPrompts As Variant, _
    ToolTips As Variant, Enabled As Variant, WantsUpdates As Variant) As Long
    'ReDim CommandNames(NUM_TOOLS, 5)
    ReDim CommandNames(NUM_TOOLS) ', 5)
    ReDim MenuCaptions(NUM_TOOLS, 2)
    ReDim StatusPrompts(NUM_TOOLS)
    ReDim ToolTips(NUM_TOOLS)
    ReDim Enabled(NUM_TOOLS)
    ReDim WantsUpdates(NUM_TOOLS)
    CommandNames(0) = LoadResString(105) '"S&DK|&Utils|File &Converter"

    MenuCaptions(0, 0) = LoadResString(106) '"&File Converter"
    MenuCaptions(0, 1) = LoadResString(107) '"SDK"

    StatusPrompts(0) = LoadResString(108) '"Launch the File Converter"
    ToolTips(0) = LoadResString(109) '"File Converter"
    Enabled(0) = True
    WantsUpdates(0) = False
    GetToolInfo = NUM_TOOLS
End Function

'Copy a windows bitmap of the requested size to the clipboard
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire bitmap:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono bitmap should be 1-bit (black or white)
Public Function CopyBitmap(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Boolean
    On Error GoTo BitmapError

    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        'Put the image on the Windows clipboard
        Clipboard.SetData TheImage, vbCFDIB
        CopyBitmap = True
        Exit Function
    End If

BitmapError:
    CopyBitmap = False
End Function

'Return a Picture object for the requested size
'Apparently, returning references to StdPicture objects doesn't work for .EXE servers
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire image:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono image should be 1-bit (black or white)
Public Function GetPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Object
    On Error GoTo PictureError

    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        Set GetPicture = TheImage
        Exit Function
    End If

PictureError:
    Set GetPicture = Nothing
End Function

'Returns true if tool is correctly initialized
Public Function Initialize(ByVal Tool As Object) As Boolean
'    Initialize = False
'    Set ObjApp = Tool.Application 'GetObject("TurboCAD.Application") 'CreateObject("IMSIGX.Application")
'    If ObjApp Is Nothing Then
'        MsgBox "Could attach to TurboCAD.  " & Err.Description & "  Quitting."
'        Exit Function
'    End If
'    Set Drs = ObjApp.Drawings
'    If Drs Is Nothing Then
'        MsgBox "Bad server.  " & Err.Description & "  Quitting"
'        Exit Function
'    End If
    Initialize = True
End Function

'Returns true if tool is correctly initialized
Public Function UpdateToolStatus(ByVal Tool As Object, Enabled As Boolean, Checked As Boolean) As Boolean
    Enabled = True 'Could do a test here to determine whether to disable the button/menu item
    Checked = False  'Could do a test here to determine whether to check the button/menu item
    UpdateToolStatus = True
End Function

'Implementation specific stuff
'Private function to return the bitmap from .Res file or .Bmp file
Private Function GetButtonPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean, TheImage As StdPicture) As Boolean
    On Error GoTo LoadError

    'There are two ways to load images:  from .Bmp file(s) or from .RES resource.
    'In this demo, we control the loading by a private variable.

    'Note that if you are loading from .Bmp, or if you are running this tool as a
    '.VBP for debugging, you must place the .Res or .Bmp files in the Draggers subdirectory
    'of the directory in which TCW40.EXE (or IMSIGX40.DLL) is located.

    If boolLoadFromBmp Then
        'Load from .Bmp file
        Dim strFileName As String 'File name of .Bmp file to load

        If LargeImage Then
            strFileName = App.Path & "\bmp2.bmp"
        Else
            strFileName = App.Path & "\bmp1.bmp"
        End If
        Set TheImage = LoadPicture(strFileName)
    Else
        'Load from .Res file
        Dim idBitmap%  'BITMAP resource id in .Res file

        If LargeImage Then
            idBitmap% = 102
        Else
            idBitmap% = 101
        End If
        Set TheImage = LoadResPicture(idBitmap%, vbResBitmap)
    End If

    'Return the image
    GetButtonPicture = True
    Exit Function

LoadError:
'        MsgBox "Error loading bitmap: " & Err.Description
        MsgBox LoadResString(113) & Err.Description
    GetButtonPicture = False
End Function


Examples - File Converter Tool - Converter.frm

Converter.frm

File Converter Tool Example

VERSION 5.00
Begin VB.Form frmConverter
   Caption         =   "TurboCAD File Converter"
   ClientHeight    =   6645
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   11415
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6645
   ScaleWidth      =   11415
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton bCancel
      Caption         =   "Cancel"
      Height          =   450
      Left            =   4125
      TabIndex        =   19
      Top             =   5880
      Visible         =   0   'False
      Width           =   1300
   End
   Begin VB.CommandButton Close
      Caption         =   "Close"
      Height          =   450
      Left            =   2055
      TabIndex        =   18
      Top             =   5880
      Width           =   1300
   End
   Begin VB.Timer Timer1
      Enabled         =   0   'False
      Interval        =   500
      Left            =   5535
      Top             =   5700
   End
   Begin VB.ComboBox Combo2
      Height          =   315
      Left            =   6960
      Style           =   2  'Dropdown List
      TabIndex        =   17
      Top             =   5200
      Width           =   4215
   End
   Begin VB.ComboBox Combo1
      Height          =   315
      ItemData        =   "Converter.frx":0000
      Left            =   1320
      List            =   "Converter.frx":0002
      MousePointer    =   1  'Arrow
      Style           =   2  'Dropdown List
      TabIndex        =   16
      Top             =   5200
      Width           =   4215
   End
   Begin VB.DriveListBox Drive2
      Height          =   315
      Left            =   6000
      TabIndex        =   6
      Top             =   1080
      Width           =   2415
   End
   Begin VB.DirListBox Dir2
      Height          =   2565
      Left            =   6000
      TabIndex        =   5
      ToolTipText     =   "Select a directory where converted files will be placed."
      Top             =   1680
      Width           =   2415
   End
   Begin VB.FileListBox File2
      Height          =   2625
      Left            =   8640
      TabIndex        =   4
      Top             =   1680
      Width           =   2415
   End
   Begin VB.FileListBox File1
      Height          =   2625
      Left            =   3000
      MultiSelect     =   2  'Extended
      TabIndex        =   3
      ToolTipText     =   "A list of files to be converted."
      Top             =   1680
      Width           =   2415
   End
   Begin VB.DirListBox Dir1
      Height          =   2565
      Left            =   360
      TabIndex        =   2
      ToolTipText     =   "Select a directory containing files for conversion."
      Top             =   1680
      Width           =   2415
   End
   Begin VB.DriveListBox Drive1
      Height          =   315
      Left            =   360
      TabIndex        =   1
      Top             =   1080
      Width           =   2415
   End
   Begin VB.CommandButton Run
      Caption         =   "Run"
      Height          =   450
      Left            =   105
      TabIndex        =   0
      ToolTipText     =   "Starts the conversion process."
      Top             =   5880
      Width           =   1300
   End
   Begin VB.Frame Source
      Caption         =   "Source:"
      Height          =   4215
      Left            =   120
      TabIndex        =   7
      Top             =   720
      Width           =   5415
      Begin VB.Label NFiles1
         Height          =   375
         Left            =   3960
         TabIndex        =   11
         Top             =   3720
         Width           =   1215
      End
      Begin VB.Label Label1
         Caption         =   "Total files:"
         Height          =   375
         Left            =   2880
         TabIndex        =   8
         Top             =   3720
         Width           =   855
      End
   End
   Begin VB.Frame Target
      Caption         =   "Destination:"
      Height          =   4215
      Left            =   5760
      TabIndex        =   9
      Top             =   720
      Width           =   5415
      Begin VB.Label NFiles2
         Height          =   375
         Left            =   4080
         TabIndex        =   12
         Top             =   3720
         Width           =   1215
      End
      Begin VB.Label Label2
         Caption         =   "Total files: "
         Height          =   375
         Left            =   2880
         TabIndex        =   10
         Top             =   3720
         Width           =   855
      End
   End
   Begin VB.Label ExportFiltersList
      Caption         =   "Files of type:"
      Height          =   375
      Left            =   5760
      TabIndex        =   15
      Top             =   5200
      Width           =   975
   End
   Begin VB.Label ImportFiltersList
      Caption         =   "Files of type:"
      Height          =   375
      Left            =   120
      TabIndex        =   14
      Top             =   5200
      Width           =   975
   End
   Begin VB.Label Label3
      BorderStyle     =   1  'Fixed Single
      Height          =   350
      Left            =   3000
      TabIndex        =   13
      Top             =   240
      Width           =   8175
   End
End
Attribute VB_Name = "frmConverter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub bCancel_KeyPress(KeyAscii As Integer)
    If (KeyAscii = vbKeyEscape And bConversionRunned = True) Then
        bInterupt = True
'        MsgBox "Cancel ESC"
    End If
End Sub

Private Sub File1_KeyPress(KeyAscii As Integer)
    If (KeyAscii = vbKeyEscape And bConversionRunned = True) Then
        bInterupt = True
'        MsgBox "Filel ESC"
    End If
End Sub
Private Sub File2_KeyPress(KeyAscii As Integer)
    If (KeyAscii = vbKeyEscape And bConversionRunned = True) Then
        bInterupt = True
'        MsgBox "File2 ESC"
    End If
End Sub
Private Sub Run_KeyPress(KeyAscii As Integer)
    If (KeyAscii = vbKeyEscape And bConversionRunned = True) Then
        bInterupt = True
'        MsgBox "Run ESC"
    End If
End Sub
Private Sub Close_KeyPress(KeyAscii As Integer)
    If (KeyAscii = vbKeyEscape And bConversionRunned = True) Then
        bInterupt = True
'        MsgBox "Close ESC"
    End If
End Sub
Private Sub Combo1_KeyPress(KeyAscii As Integer)
    If (KeyAscii = vbKeyEscape And bConversionRunned = True) Then
        bInterupt = True
'        MsgBox "Combo1 ESC"
    End If
End Sub
Private Sub Combo2_KeyPress(KeyAscii As Integer)
    If (KeyAscii = vbKeyEscape And bConversionRunned = True) Then
        bInterupt = True
'        MsgBox "Combo2 ESC"
    End If
End Sub
Private Sub Drive1_KeyPress(KeyAscii As Integer)
    If (KeyAscii = vbKeyEscape And bConversionRunned = True) Then
        bInterupt = True
'        MsgBox "Drive1 ESC"
    End If
End Sub
Private Sub Drive2_KeyPress(KeyAscii As Integer)
    If (KeyAscii = vbKeyEscape And bConversionRunned = True) Then
        bInterupt = True
'        MsgBox "Drive2 ESC"
    End If
End Sub
Private Sub Dir1_KeyPress(KeyAscii As Integer)
    If (KeyAscii = vbKeyEscape And bConversionRunned = True) Then
        bInterupt = True
'        MsgBox "Dir1 ESC"
    End If
End Sub
Private Sub Dir2_KeyPress(KeyAscii As Integer)
    If (KeyAscii = vbKeyEscape And bConversionRunned = True) Then
        bInterupt = True
'        MsgBox "Dir2 ESC"
    End If
End Sub

'Private Sub Form_KeyPress(KeyAscii As Integer)
Private Sub Form_KeyPress(KeyAscii As Integer)

    If (KeyAscii = vbKeyEscape And bConversionRunned = True) Then
        bInterupt = True
'        MsgBox "Test Esc key"
    End If
End Sub

'Private Sub bCancel_Click()
'        bInterupt = True
'        MsgBox "Cancel click"
'End Sub

Private Sub File1_PatternChange()
    File1.Refresh
End Sub
Private Sub File2_PatternChange()
    File2.Refresh
End Sub
Private Sub Close_Click()
    Unload frmConverter
'    Set Dr = Nothing
    Set Drs = Nothing
'   Set ObjApp = Nothing

End Sub

Private Sub Combo1_LostFocus()
    Timer1.Enabled = False
'    File1.Pattern = Left((Right(Combo1.Text, 6)), 5)
    File1.Pattern = "*." & Left(Combo1.Text, 3)
    File1.Refresh
    NFiles1.Caption = File1.ListCount
End Sub

Private Sub Combo1_GotFocus()
    CurCombo = True
    Timer1.Enabled = True
    CurImportFilter = Combo1.Text
End Sub
Private Sub Combo2_LostFocus()
    Timer1.Enabled = False
'    File2.Pattern = Left((Right(Combo2.Text, 6)), 5)
    File2.Pattern = "*." & Left(Combo2.Text, 3)
    File2.Refresh
    NFiles2.Caption = File2.ListCount

End Sub

Private Sub Combo2_GotFocus()
    CurCombo = False
    Timer1.Enabled = True
    CurExportFilter = Combo2.Text

End Sub
Private Sub Dir1_Change()
    File1.FileName = Dir1.Path
    File1.Refresh
    NFiles1.Caption = File1.ListCount

End Sub

Private Sub Dir2_Change()
    File2.FileName = Dir2.Path
    File2.Refresh
    NFiles2.Caption = File2.ListCount

End Sub
Private Sub Drive1_Change()
'    MsgBox Dir1.Path
    On Error GoTo ErrHandler
    Err.Clear
    Dir1.Path = Drive1.Drive
    Dir1.Refresh
    File1.FileName = Dir1.Path
    File1.Refresh
    NFiles1.Caption = File1.ListCount
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbOKOnly, LoadResString(101)
    Drive1.Refresh
    Dir1.Path = Drive1.Drive
    Dir1.Refresh
    File1.FileName = Dir1.Path
    File1.Refresh
    NFiles1.Caption = File1.ListCount
    Err.Clear
End Sub

Private Sub Drive2_Change()
'    MsgBox Dir1.Path
    On Error GoTo ErrHandler
    Err.Clear

    Dir2.Path = Drive2.Drive
    Dir2.Refresh
    File2.FileName = Dir2.Path
    File2.Refresh
    NFiles2.Caption = File2.ListCount
    Exit Sub

ErrHandler:
    MsgBox Err.Description, vbOKOnly, LoadResString(101)
    Drive2.Refresh
    Dir2.Path = Drive2.Drive
    Dir2.Refresh
    File2.FileName = Dir2.Path
    File2.Refresh
    NFiles2.Caption = File2.ListCount
    Err.Clear

End Sub

Private Sub Form_Load()
    bInterupt = False
    bConversionRunned = False
'    frmConverter.bCancel.Enabled = False
    Call Init_ReadFiltersList
    File1.Refresh
    Call Init_WriteFiltersList
    File2.Refresh
End Sub

Private Sub Run_Click()
    On Error GoTo ErrorHandler

    Dim CadFile As String
    Dim CadFileSave As String
    Dim temp As String
    Dim ext As String
    Dim bSave As Boolean
    bSave = False

    ext = Left((Right(Combo1.Text, 4)), 3)

    Dim i, b As Integer
    i = 0
    b = File1.ListCount

    If (b = 0) Then
'        MsgBox "No " & ext & " files in source directory", vbOKOnly, "TurboCAD  File Converter"
        MsgBox LoadResString(111) & ext & LoadResString(112), vbOKOnly, LoadResString(101)
        Exit Sub
    End If
    frmConverter.Close.Enabled = False
    bConversionRunned = True
    frmConverter.Run.Enabled = False
 ''   frmConverter.bCancel.Enabled = True
'    frmConverter.Run.Caption = "Cancel"
'    ObjApp.Properties("PromptForSummaryInfo") = False

'    If Not (CheckSourceFileList()) Then
    If (CheckSourceFileList()) Then
    Else
'        MsgBox "No files selected for conversion !", vbOKOnly, "TurboCAD  File Converter"
        MsgBox LoadResString(110), vbOKOnly, LoadResString(101)
        Call EnableButtons
        Exit Sub
    End If
    i = 0
    While (i < b)

        If (File1.Selected(i) = True) Then
'           Label3.Caption = File1.List(i) + " file is being converted"
           Label3.Caption = File1.List(i) + LoadResString(114)
           Label3.Refresh

           temp = Right(File1.Path, 1)
           If (temp = "\") Then
               CadFile = File1.Path & File1.List(i)
           Else
               CadFile = File1.Path & "\" & File1.List(i)
           End If

           On Error Resume Next
           Err.Clear
           Set Dr = Drs.Open(CadFile)
           If Err.Number <> 0 Then
                Err.Clear
                GoTo NextFile
           End If

           temp = Right(File2.Path, 1)

           CadFileSave = Left(File1.List(i), (Len(File1.List(i)) - 4)) ' clip the extesion of the file

           If (temp = "\") Then
               CadFileSave = File2.Path & CadFileSave & "." & Left(Combo2.Text, 3) ')Left((Right(Combo2.Text, 5)), 4)
           Else
               CadFileSave = File2.Path & "\" & CadFileSave & "." & Left(Combo2.Text, 3) 'Left((Right(Combo2.Text, 5)), 4)
           End If

           Dr.SaveAs (CadFileSave)
           Dr.Close bSave
NextFile:
           Set Dr = Nothing
           File2.Refresh
           NFiles2.Caption = File2.ListCount
           NFiles2.Refresh
           If (bInterupt = True) Then b = i + 1  'GoTo ConversionInterUpt
        End If
        i = i + 1

    Wend

    If (bInterupt = True) Then
'        MsgBox "Conversion interrupted by user !", vbOKOnly, "TurboCAD  file converter"
        MsgBox LoadResString(115), vbOKOnly, LoadResString(101)
    Else
'        MsgBox "Conversion is complete !", vbOKOnly, "TurboCAD  file converter"
        MsgBox LoadResString(116), vbOKOnly, LoadResString(101)
    End If
    Label3.Caption = ""
    Label3.Refresh
    frmConverter.Close.Enabled = True
    bConversionRunned = False
    frmConverter.Run.Enabled = True
'    ObjApp.Properties("PromptForSummaryInfo") = isSummInfo

''    frmConverter.bCancel.Enabled = False
Exit Sub

ErrorHandler:
    MsgBox Err.Description, , vbOKOnly, LoadResString(101)
    frmConverter.Close.Enabled = True
    bConversionRunned = False
    frmConverter.Run.Enabled = True
'    ObjApp.Properties("PromptForSummaryInfo") = isSummInfo

''    frmConverter.bCancel.Enabled = False
End Sub

'Private Sub SetupR_Click()

'    Exit Sub
'    On Error GoTo ErrH
'    Err.Clear
'    Dim ext As String
'    Dim descr As String
'    descr = Combo1.Text
'    ext = Left((Right(Combo1.Text, 6)), 3)
'    ext = Left((Right(Combo1.Text, 4)), 3)
'    Dim hApp As Long
'    Dim ret As Boolean
'    Dim b As Boolean
'    b = True
'    hApp = 0
'    hApp = AppGetCurrentApp
'    ret = AppSetupFilter(hApp, b, ext, descr)

 '   Exit Sub
'ErrH:
'    MsgBox Err.Description

'End Sub

'Private Sub SetupW_Click()
'    Exit Sub
'    On Error GoTo ErrH
'    Err.Clear
'    Dim ext As String
'    Dim descr As String
'    descr = Combo2.Text
''    ext = Left((Right(Combo1.Text, 6)), 5)
'    ext = Left((Right(Combo2.Text, 4)), 3)
'    Dim hApp As Long
'    Dim ret As Boolean
'    Dim b As Boolean
'    b = False
'    hApp = 0
'    hApp = AppGetCurrentApp
'    ret = AppSetupFilter(hApp, b, ext, descr)
'

'    Exit Sub
'ErrH:
'    MsgBox Err.Description

'End Sub

Sub Timer1_Timer()
    If (CurCombo = True) Then
        If (CurImportFilter <> Combo1.Text) Then
'            File1.Pattern = Left((Right(Combo1.Text, 6)), 5)
            File1.Pattern = "*." & Left(Combo1.Text, 3)
            File1.Refresh
            NFiles1.Caption = File1.ListCount
        End If
    Else
        If (CurExportFilter <> Combo2.Text) Then
'            File2.Pattern = Left((Right(Combo2.Text, 6)), 5)
            File2.Pattern = "*." & Left(Combo2.Text, 3)
            File2.Refresh
            NFiles2.Caption = File2.ListCount
        End If
    End If

End Sub
Public Sub Init_ReadFiltersList()
Dim n As Long
Dim Ft As Filter  ' Object  'AddIn
Dim FtName As String
Dim i As Long

i = 0
Set Ftrs = ObjApp.Filters
n = Ftrs.Count
Combo1.Clear

While (i < n)
    Set Ft = Ftrs.Item(i)
    If (Ft.Capability = imsiRead Or Ft.Capability = imsiReadWrite) Then
        If (Ft.Hidden = False) Then
            FtName = Ft.FilterString
            FtName = Left(FtName, (Len(FtName) - 8))
'            Combo1.AddItem FtName
            Combo1.AddItem Ft.Extension & " " & " - " & Ft.Description
        End If
    End If
    i = i + 1
Wend
Combo1.ListIndex = 0
'File1.Pattern = Left((Right(Combo1.Text, 6)), 5)
File1.Pattern = "*." & Left(Combo1.Text, 3) '& Ft.Extension

File1.Refresh
NFiles1.Caption = File1.ListCount
Combo1.Refresh
End Sub
Public Sub Init_WriteFiltersList()
Dim n As Long
Dim Ft As Filter  ' Object  'AddIn
Dim FtName As String
Dim i As Long

i = 0
Set Ftrs = ObjApp.Filters
n = Ftrs.Count
Combo2.Clear

While (i < n)
    Set Ft = Ftrs.Item(i)
    If (Ft.Capability = imsiWrite Or Ft.Capability = imsiReadWrite) Then
        If (Ft.Hidden = False) Then
            If (Ft.Extension(0) <> "BMF") Then
                FtName = Ft.FilterString
                FtName = Left(FtName, (Len(FtName) - 8))
'                Combo2.AddItem FtName
                Combo2.AddItem Ft.Extension & " " & " - " & Ft.Description
            End If
        End If
    End If
    i = i + 1
Wend
Combo2.ListIndex = 1
'File2.Pattern = Left((Right(Combo2.Text, 6)), 5)
'MsgBox File2.Pattern
File2.Pattern = "*." & Left(Combo2.Text, 3) '& Ft.Extension

File2.Refresh
NFiles2.Caption = File2.ListCount
Combo2.Refresh

End Sub

Private Function CheckSourceFileList() As Boolean
    Dim i As Integer
    Dim b As Integer
    i = 0
    b = File1.ListCount
    CheckSourceFileList = False
    While (i < b)
        If (File1.Selected(i) = True) Then
            CheckSourceFileList = True
            Exit Function
        End If
        i = i + 1
    Wend
End Function
Private Sub EnableButtons()
    frmConverter.Close.Enabled = True
    bConversionRunned = False
    frmConverter.Run.Enabled = True
End Sub


Examples - Gear Contour Tool - GearContour.bas

GearContour.bas

Gear Contour Tool Example

Attribute VB_Name = "modGearContour"
Option Explicit
Type SelInfo
    nV As Long
    xV() As Double
    yV() As Double
End Type

Type ArcData
    NumCen As Long
    ArcCen(1000) As Long
    xMid(1000) As Double
    yMid(1000) As Double
End Type

Global objApp As XApplication
Global Drs As Drawings
Global ActDr As Drawing
Global Grs As Graphics
Global Vis As Views
Global Vi As View
Global Const Pi = 3.14159265359
Global Const Eps = 0.000001
Global ParamCanc As Boolean
Global FileWrite As Boolean

Sub Main()
End Sub


Examples - Gear Contour Tool - GearContour.cls

GearContour.cls

Gear Contour Tool Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Contour"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'Number of tools in this server
Const NUM_TOOLS = 1
Public xcWorld As Double
Public ycWorld As Double

' *******************************************************************
'    Const EventMask = 268435456 + 536870912
'    Const EventMask = 1024 + 268435456 + 536870912
    Const EventMask = 1 + 2 + 4 + 8 + 16 + 32 + 64 + 1024 + 4096 + 262144 + 268435456 + 536870912

    Private iConnectId As Long
    Private iActTool As Long
    Private theToolEvents As IToolEvents

' *******************************************************************
'Toggle this to test loading buttons from .Bmp/.Res
Const boolLoadFromBmp As Boolean = False
Const boolDebug As Boolean = False
'##########################################################################
'##########################################################################
Private Declare Function TCWUndoClear Lib "TCAPI70.dll" () As Long
Private Declare Function TCWUndoRecordEnd Lib "TCAPI70.dll" (ByVal d As Long) As Long
Private Declare Function TCWUndoRecordStart Lib "TCAPI70.dll" (ByVal d As Long, ByRef Title As String) As Long
Private Declare Function TCWUndoRecordAddGraphic Lib "TCAPI70.dll" (ByVal d As Long, ByVal g As Long) As Long
Private Declare Function TCWUndo Lib "TCAPI70.dll" (ByVal N As Long) As Long

Private Declare Function TCWDrawingActive Lib "TCAPI70.dll" () As Long
Private Declare Function TCWGraphicAt Lib "TCAPI70.dll" (ByVal d As Long, ByVal Index As Long) As Long
Private Declare Function TCWVertexAt Lib "TCAPI70.dll" (ByVal g As Long, ByVal Index As Long) As Long

Private Declare Sub prVertexSetSomeFlags Lib "DBAPI70.dll" (ByVal hVer As Long, ByVal FlagOn As Long, ByVal FlagOff As Long)

Private Declare Function GraphicGetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long) As Long
Private Declare Function GraphicSetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long, ByVal hMat As Long) As Boolean
Private Declare Function MatrixEqual Lib "DBAPI70.dll" (ByVal hM1 As Long, ByVal hM2 As Long) As Boolean

Private Declare Function TCWViewRedraw Lib "TCAPI70.dll" () As Long

Private hDr As Long

'Copy a windows bitmap of the requested size to the clipboard
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire bitmap:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono bitmap should be 1-bit (black or white)
Public Function CopyBitmap(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Boolean
    On Error GoTo BitmapError

    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        'Put the image on the Windows clipboard
        Clipboard.SetData TheImage, vbCFDIB
        CopyBitmap = True
        Exit Function
    End If

BitmapError:
    CopyBitmap = False
End Function

'Return a Picture object for the requested size
'Apparently, returning references to StdPicture objects doesn't work for .EXE servers
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire image:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono image should be 1-bit (black or white)
Public Function GetPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Object
    On Error GoTo PictureError

    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        Set GetPicture = TheImage
        Exit Function
    End If

PictureError:
    Set GetPicture = Nothing
End Function

'Implementation specific stuff
'Private function to return the bitmap from .Res file or .Bmp file
Private Function GetButtonPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean, TheImage As StdPicture) As Boolean
    On Error GoTo LoadError

    'There are two ways to load images:  from .Bmp file(s) or from .RES resource.
    'In this demo, we control the loading by a private variable.

    'Note that if you are loading from .Bmp, or if you are running this tool as a
    '.VBP for debugging, you must place the .Res or .Bmp files in the Draggers subdirectory
    'of the directory in which TCW40.EXE (or IMSIGX40.DLL) is located.

    If boolLoadFromBmp Then
        'Load from .Bmp file
        Dim strFileName As String 'File name of .Bmp file to load

        If LargeImage Then
            strFileName = App.Path & "\button24.bmp"
        Else
            strFileName = App.Path & "\button16.bmp"
        End If
        Set TheImage = LoadPicture(strFileName)
    Else
        'Load from .Res file
        Dim idBitmap%  'BITMAP resource id in .Res file

        If LargeImage Then
            idBitmap% = 1002
        Else
            idBitmap% = 1001
        End If
        Set TheImage = LoadResPicture(idBitmap%, vbResBitmap)
    End If

    'Return the image
    GetButtonPicture = True
    Exit Function

LoadError:
    If boolDebug Then
'        MsgBox "Error loading bitmap: " & Err.Description
    End If
    GetButtonPicture = False
End Function

'##########################################################################
'##########################################################################
'##########################################################################

'Return a description string for this package of tools
Public Property Get Description() As String
    Description = "AddGearContour"
End Property

'Called to perform tool function
Public Function Run(ByVal Tool As Object) As Boolean
    On Error GoTo ErrorHandler
Dim theXTool As Tool
    Set theXTool = Tool
'    theXTool.Application.ActiveDrawing.Graphics.Unselect
    If iConnectId <> -1 Then
        objApp.DisconnectEvents iConnectId
        AddLM False
        iConnectId = -1
        iActTool = -1
        theToolEvents.ToolChangePrompt Me, "", False
    Else
        theToolEvents.ToolChangePrompt Me, "", False
        theToolEvents.ToolChangePrompt Me, "Input Data", False
        ParamCanc = True
        frmGearContour.Show 1
        If ParamCanc = True Then
            If iConnectId <> -1 Then
                theToolEvents.ToolChangePrompt Me, "", False
                objApp.DisconnectEvents iConnectId
                iConnectId = -1
                AddLM False
            End If
            Call Finish
            Exit Function
        End If
       iConnectId = objApp.ConnectEvents(Me, EventMask)
        iActTool = theXTool.Index
        AddLM True
        theToolEvents.ToolChangePrompt Me, "Click the cener of the Gear Contour", False
    End If
    Set ActDr = Tool.Application.ActiveDrawing
    Set Grs = ActDr.Graphics

'    Call GearContour
'    Call Finish
'    If iConnectId <> -1 Then
'        objApp.DisconnectEvents iConnectId
'        AddLM False
'        iConnectId = -1
'        iActTool = -1
'        theToolEvents.ToolChangePrompt Me, "", False
'    End If

    Exit Function
ErrorHandler:
'    MsgBox Err.Msg
    Call Finish
End Function

'Fill arrays with information about tools in the package
'Return the number of tools in the package
Public Function GetToolInfo(CommandNames As Variant, MenuCaptions As Variant, StatusPrompts As Variant, _
    ToolTips As Variant, Enabled As Variant, WantsUpdates As Variant) As Long

    ReDim CommandNames(NUM_TOOLS)
    ReDim MenuCaptions(NUM_TOOLS)
    ReDim StatusPrompts(NUM_TOOLS)
    ReDim ToolTips(NUM_TOOLS)
    ReDim Enabled(NUM_TOOLS)
    ReDim WantsUpdates(NUM_TOOLS)
    CommandNames(0) = "SDK|Gear Contour"
    MenuCaptions(0) = "&Gear Contour"
    ToolTips(0) = "Gear Contour"
    Enabled(0) = True
    WantsUpdates(0) = False
    GetToolInfo = NUM_TOOLS
End Function

'Returns true if tool is correctly initialized
Public Function Initialize(ByVal Tool As Object) As Boolean
On Error GoTo ErrorHandler
    Set objApp = Tool.Application
    Set theToolEvents = objApp
    iConnectId = -1
    iActTool = -1
    Initialize = True
    Exit Function
ErrorHandler:
 '   MsgBox Err.Description
End Function

'Returns true if tool is correctly initialized
Public Function UpdateToolStatus(ByVal Tool As Object, Enabled As Boolean, Checked As Boolean) As Boolean
    Enabled = True 'Could do a test here to determine whether to disable the button/menu item
    If iConnectId = -1 Then
        Checked = False  'Could do a test here to determine whether to check the button/menu item
    Else
        Checked = True
    End If
    UpdateToolStatus = True
End Function

Public Function RunTool(WhichTool As Tool)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function

Public Function BeforeExit(WhichApplication As Application, Cancel As Boolean)
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    Call Finish

End Function
Public Function DrawingNew(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False

    Call Finish
End Function
Public Function DrawingOpen(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function
Public Function DrawingActivate(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function
Public Function DrawingDeactivate(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function
Public Function DrawingBeforeClose(WhichDrawing As Drawing, Cancel As Boolean)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function
Public Function DrawingBeforeSave(WhichDrawing As Drawing, SaveAs As Boolean, Cancel As Boolean)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    Call Finish
End Function

Public Function MouseDown(WhichDrawing As Drawing, WhichView As View, WhichWindow As Window, Button As ImsiMouseButton, Shift As Long, x As Long, y As Long, Cancel As Boolean)
Dim xClick#, yClick#
On Error GoTo ErrorHandler
    Set Drs = objApp.Drawings
    Set ActDr = WhichDrawing
    Set Grs = ActDr.Graphics
    Set Vis = ActDr.Views
    Set Vi = WhichView
    hDr = TCWDrawingActive

    Vi.ScreenToView x, y, xClick, yClick
    Vi.ViewToWorld xClick, yClick, 0, xcWorld, ycWorld, 0
'MsgBox ("xcWorld=" & CStr(xcWorld) & "  ycWorld=" & CStr(ycWorld))

    If Button = imsiLeftButton Then
'        Cancel = True
 '       theToolEvents.ToolChangePrompt Me, "", False
'        Vi.Refresh
'        theToolEvents.ToolChangePrompt Me, "Pick any field of the Schedule", False
'    Else
'        Call GearContour
        Call TeethInvol
        Vi.ZoomToExtents
        If iConnectId <> -1 Then
            theToolEvents.ToolChangePrompt Me, "", False
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
            AddLM False
        End If
        Grs.Unselect
        Call Finish
        Cancel = False
    End If
'    Call Finish
    Exit Function
ErrorHandler:
    If iConnectId <> -1 Then
        theToolEvents.ToolChangePrompt Me, "", False
        objApp.DisconnectEvents iConnectId
        iConnectId = -1
        AddLM False
    End If
    Call Finish
 '   MsgBox Err.Description
End Function

Public Function Cancel(DoItPlease As Boolean, CanCancel As Boolean)
    If (DoItPlease) Then
        If iConnectId <> -1 Then
            theToolEvents.ToolChangePrompt Me, "", False
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
        End If

        theToolEvents.ToolChangePrompt Me, "", False
        Call Finish
    End If

    CanCancel = True
End Function

Public Function UpdateUndo(AllowsUndo As Boolean)
    AllowsUndo = False
End Function

Private Function AddActToolLM(iTool As Long, bAdd As Boolean)
'    AddLM bAdd
End Function
Private Sub Class_Terminate()
    If (Not theToolEvents Is Nothing) Then
        Set theToolEvents = Nothing
    End If
    If (Not objApp Is Nothing) Then
        Set objApp = Nothing
    End If

End Sub

Private Function AddLM(bAdd As Boolean)
Dim Captions(0 To 0) As String
Dim Prompts(0 To 0) As String
Dim Enabled(0 To 0) As Boolean
Dim Checked(0 To 0) As Boolean

Dim varCaptions As Variant
Dim varPrompts As Variant
Dim varEnabled As Variant
Dim varChecked As Variant

    If (bAdd) Then
        Captions(0) = "Finish GearContour"
        Prompts(0) = "Finish GearContour"
        Enabled(0) = True
        Checked(0) = True
        varCaptions = Captions
        varPrompts = Prompts
        varEnabled = Enabled
        varChecked = Checked

        theToolEvents.ToolChangeCommands Me, 1, varCaptions, varPrompts, varEnabled, varChecked, True
    Else
        theToolEvents.ToolChangeCommands Me, 0, , , , , False
    End If
End Function

Public Function DoLMCommand(CmdInd As Long)
'MsgBox ("CmdInd=" & CStr(CmdInd))
   If CmdInd = 0 Then
         If iConnectId <> -1 Then
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
            AddLM False
        End If
        theToolEvents.ToolChangePrompt Me, "", False

        Call Finish
'        Set objApp = Nothing

    End If

End Function
Private Sub Finish()
    Set Grs = Nothing
    Set Vi = Nothing
    Set Vis = Nothing
    Set ActDr = Nothing
    Set Drs = Nothing
 '   Set objApp = Nothing
End Sub

Private Sub GearContour()
Dim Gr As Graphic

Dim N% 'Number of Teeth
Dim Db# 'Base Circle Diameter
Dim D0# ' Outside Diameter
Dim Dr# ' Root Diameter
Dim d# 'Pitch Diameter
Dim a# 'Addendum
Dim b# 'Dedendum
Dim Pd# 'Diametral Pitch
Dim Pc# 'Circular Pitch
Dim ht# ' Whole Depth of Tooth
Dim tet# 'Pressure Angle
Dim GearWidth#
'    frmGearContour.Show 1
    N = CInt(frmGearContour.TeethCount.Text)
    If N < 8 Then N = 10
    If N > 30 Then N = 30
    Pd = CDbl(frmGearContour.DiamPitch.Text)
'    GearWidth = CDbl(UserForm1.GearWidth.Text)
    tet = CDbl(frmGearContour.PressureAngle.Text) / 180 * Pi

'    N = 20
'    Pd = 2
'    tet = 20 / 180 * Pi
    d = N / Pd
    Pc = Pi * d / N
    D0 = (N + 2) / Pd
    Db = d * Cos(tet)
    a = 0.3183 * Pc
    b = 0.3979 * Pc
    ht = a + b
    Dr = D0 - 2 * ht
Dim x0#, y0#, z0#
    x0 = 0
    y0 = 0
    z0 = 0
'Outside circle
'    Set Gr = Grs.AddCircleCenterAndPoint(x0, y0, z0, x0 + D0 / 2, y0, z0)
'    Gr.Properties("PenColor") = RGB(0, 255, 0)
'    Gr.Properties("PenStyle") = "DASHED"

'Inside Circle
'    Set Gr = Grs.AddCircleCenterAndPoint(x0, y0, z0, x0 + Dr / 2, y0, z0)
'    Gr.Properties("PenColor") = RGB(0, 255, 0)
'    Gr.Properties("PenStyle") = "DASHED"
'Base Circle
'    Set Gr = Grs.AddCircleCenterAndPoint(x0, y0, z0, x0 + Db / 2, y0, z0)
'    Gr.Properties("PenColor") = RGB(255, 0, 0)
'    Gr.Properties("PenStyle") = "DASHED"
'Pitch Circle
'    Set Gr = Grs.AddCircleCenterAndPoint(x0, y0, z0, x0 + d / 2, y0, z0)
'    Gr.Properties("PenColor") = RGB(0, 0, 255)
'    Gr.Properties("PenStyle") = "DASHED"

    If Db < Dr Then Db = 1.01 * Dr

' First side of the tooth
Dim St# 'Circular Tooth Thickness
Dim Et# 'Circular Hole Thickness
    St = 1.53 / Pi * Pc ' Fot Internal Gears
'    St = 1.61159 / Pi * Pc ' Fot External Gears
    Et = Pc - St

Dim fi#, dfi#, fia#, xa#, ya#
    fi = 0
    dfi = St / (d / 2)
    fia = fi + dfi / 2
    xa = x0 + d / 2 * Cos(dfi / 2)
    ya = y0 + d / 2 * Sin(dfi / 2)

Dim xc#, yc#, R#
    R = d / 6
Dim lcc#, sina#, cosa#
    lcc = Sqr((x0 - xa) * (x0 - xa) + (y0 - ya) * (y0 - ya))
    sina = (ya - y0) / lcc
    cosa = (xa - x0) / lcc
Dim CosAlp#
    CosAlp = (lcc * lcc + Db * Db / 4 - R * R) / (2 * lcc * Db / 2)
Dim xlocint#, ylocint#
    xlocint = Db / 2 * CosAlp
    ylocint = -Db / 2 * Sqr(1 - CosAlp * CosAlp)
Dim xint#, yint#
    xint = x0 + xlocint * cosa - ylocint * sina
    yint = y0 + xlocint * sina + ylocint * cosa

' Point on Outside circle
    lcc = Db / 2
    sina = (yint - y0) / lcc
    cosa = (xint - x0) / lcc
    CosAlp = (D0 * D0 / 4 + Db * Db / 4 - R * R) / (2 * D0 / 2 * Db / 2)
    xlocint = D0 / 2 * CosAlp
    ylocint = D0 / 2 * Sqr(1 - CosAlp * CosAlp)
Dim xInt1#, yInt1#
    xInt1 = x0 + xlocint * cosa - ylocint * sina
    yInt1 = y0 + xlocint * sina + ylocint * cosa
'Set Gr = Grs.AddStar(xint1, yint1, 0)

' Point on Base circle

    sina = (yint - y0) / lcc
    cosa = (xint - x0) / lcc
    CosAlp = (Db * Db / 4 + Db * Db / 4 - R * R) / (2 * Db / 2 * Db / 2)
    xlocint = Db / 2 * CosAlp
    ylocint = Db / 2 * Sqr(1 - CosAlp * CosAlp)
Dim xInt2#, yInt2#
    xInt2 = x0 + xlocint * cosa - ylocint * sina
    yInt2 = y0 + xlocint * sina + ylocint * cosa
'Set Gr = Grs.AddStar(xint2, yint2, 0)

'add evolvente curve as arc
Dim GrTeeth As Graphic
    Set GrTeeth = Grs.Add(11)
Dim Gr1 As Graphic
    Set Gr1 = GrTeeth.Graphics.AddArcTriplePoint(xInt1, yInt1, 0, xa, ya, 0, xInt2, yInt2, 0)
    GrTeeth.Graphics.Remove Gr1.Index
    Grs.AddGraphic Gr1
'Add the line segment
Dim TanAlp#, alp
    TanAlp = -(xInt2 - xint) / (yInt2 - yint)
    alp = Atn(TanAlp)
    sina = Sin(alp)
    cosa = Cos(alp)
Dim xloc0#, yloc0#
    yloc0 = (y0 - yInt2) * cosa - (x0 - xInt2) * sina
    xloc0 = (y0 - yInt2) * sina + (x0 - xInt2) * cosa
Dim dxloc#
    dxloc = -Sqr(Dr * Dr / 4 - yloc0 * yloc0)

    xlocint = xloc0 - dxloc
    ylocint = 0
Dim xint3#, yint3#
    xint3 = xInt2 + xlocint * cosa - ylocint * sina
    yint3 = yInt2 + xlocint * sina + ylocint * cosa
'Set Gr = Grs.AddStar(xint3, yint3, 0)
Dim Gr2 As Graphic
    Set Gr2 = GrTeeth.Graphics.AddLineSingle(xInt2, yInt2, 0, xint3, yint3, 0)
    GrTeeth.Graphics.Remove Gr2.Index
    Grs.AddGraphic Gr2

' Add arc segment on Outsdide circle
Dim Gr3 As Graphic
    Set Gr3 = GrTeeth.Graphics.AddArcTriplePoint(xInt1, yInt1, 0, D0 / 2, 0, 0, xInt1, -yInt1, 0)
    GrTeeth.Graphics.Remove Gr3.Index
    Grs.AddGraphic Gr3

'add second evolvente curve as arc
Dim Gr4 As Graphic
    Set Gr4 = GrTeeth.Graphics.AddArcTriplePoint(xInt1, -yInt1, 0, xa, -ya, 0, xInt2, -yInt2, 0)
    GrTeeth.Graphics.Remove Gr4.Index
    Grs.AddGraphic Gr4

'Add the line segment
Dim Gr5 As Graphic
    Set Gr5 = GrTeeth.Graphics.AddLineSingle(xInt2, -yInt2, 0, xint3, -yint3, 0)
    GrTeeth.Graphics.Remove Gr5.Index
    Grs.AddGraphic Gr5

' Add Arc on Inside circle
Dim StepAngle#, AngleBottom#, Angl0#
    StepAngle = 2 * Pi / N
    Angl0 = Atn((yint3 - y0) / (xint3 - x0))
    AngleBottom = StepAngle - 2 * Atn((yint3 - y0) / (xint3 - x0))
Dim xMid#, yMid#, xk#, yk#
    xMid = x0 + Dr / 2 * Cos(-Angl0 - AngleBottom / 2)
    yMid = y0 + Dr / 2 * Sin(-Angl0 - AngleBottom / 2)
    xk = x0 + Dr / 2 * Cos(-Angl0 - AngleBottom)
    yk = y0 + Dr / 2 * Sin(-Angl0 - AngleBottom)
Dim Gr6 As Graphic
    Set Gr6 = GrTeeth.Graphics.AddArcTriplePoint(xint3, -yint3, 0, xMid, yMid, 0, xk, yk, 0)
    GrTeeth.Graphics.Remove Gr6.Index
    Grs.AddGraphic Gr6
Dim GrGroup As Graphic
    Set GrGroup = Grs.Add(imsiGroup)

Dim Gr1Dup As Graphic
Dim Gr2Dup As Graphic
Dim Gr3Dup As Graphic
Dim Gr4Dup As Graphic
Dim Gr5Dup As Graphic
Dim Gr6Dup As Graphic

    Set Gr1Dup = Gr1.Duplicate
    Set Gr2Dup = Gr2.Duplicate
    Set Gr3Dup = Gr3.Duplicate
    Set Gr4Dup = Gr4.Duplicate
    Set Gr5Dup = Gr5.Duplicate
    Set Gr6Dup = Gr6.Duplicate

Dim GrIndex As Long
    With GrGroup.Graphics
        GrIndex = Gr2Dup.Index
        Grs.Remove GrIndex
        .AddGraphic Gr2Dup

        GrIndex = Gr1Dup.Index
        Grs.Remove GrIndex
        .AddGraphic Gr1Dup

        GrIndex = Gr3Dup.Index
        Grs.Remove GrIndex
        .AddGraphic Gr3Dup

        GrIndex = Gr4Dup.Index
        Grs.Remove GrIndex
        .AddGraphic Gr4Dup

        GrIndex = Gr5Dup.Index
        Grs.Remove GrIndex
        .AddGraphic Gr5Dup

        GrIndex = Gr6Dup.Index
        Grs.Remove GrIndex
        .AddGraphic Gr6Dup

Dim i%
        For i = 2 To N
            Set Gr2Dup = Gr2.Duplicate
            Set Gr1Dup = Gr1.Duplicate
            Set Gr3Dup = Gr3.Duplicate
            Set Gr4Dup = Gr4.Duplicate
            Set Gr5Dup = Gr5.Duplicate
            Set Gr6Dup = Gr6.Duplicate

            fi = -StepAngle * (i - 1)

            Gr2Dup.RotateAxis fi, 0, 0, 1, x0, y0, z0
            Gr1Dup.RotateAxis fi, 0, 0, 1, x0, y0, z0
            Gr3Dup.RotateAxis fi, 0, 0, 1, x0, y0, z0
            Gr4Dup.RotateAxis fi, 0, 0, 1, x0, y0, z0
            Gr5Dup.RotateAxis fi, 0, 0, 1, x0, y0, z0
            Gr6Dup.RotateAxis fi, 0, 0, 1, x0, y0, z0

            GrIndex = Gr2Dup.Index
            Grs.Remove GrIndex
            .AddGraphic Gr2Dup

            GrIndex = Gr1Dup.Index
            Grs.Remove GrIndex
            .AddGraphic Gr1Dup

            GrIndex = Gr3Dup.Index
            Grs.Remove GrIndex
            .AddGraphic Gr3Dup

            GrIndex = Gr4Dup.Index
            Grs.Remove GrIndex
            .AddGraphic Gr4Dup

            GrIndex = Gr5Dup.Index
            Grs.Remove GrIndex
            .AddGraphic Gr5Dup

            GrIndex = Gr6Dup.Index
            Grs.Remove GrIndex
            .AddGraphic Gr6Dup
        Next i
    End With

    Gr1.Deleted = True
    Gr2.Deleted = True
    Gr3.Deleted = True
    Gr4.Deleted = True
    Gr5.Deleted = True
    Gr6.Deleted = True
    GrTeeth.Deleted = True

Dim GrGearContour As Graphic
    Set GrGearContour = Grs.Add(, "TCW50Polyline")
    Call Polyline50(GrGroup, False, xint3, yint3, GrGearContour)
'MsgBox ("xcWorld=" & CStr(xcWorld) & "  ycWorld=" & CStr(ycWorld))
    GrGearContour.MoveRelative xcWorld, ycWorld, 0
'    GrGearContour.Properties("PenColor") = RGB(255, 0, 0)
    If GearWidth > 0 Then
        GrGearContour.Properties("Thickness") = GearWidth
        GrGearContour.Properties("Solid") = 1
    End If

    TCWViewRedraw

    Set Gr = Nothing
    Set Gr1 = Nothing
    Set Gr2 = Nothing
    Set Gr3 = Nothing
    Set Gr4 = Nothing
    Set Gr5 = Nothing
    Set Gr6 = Nothing
    Set GrTeeth = Nothing
    Set Gr1Dup = Nothing
    Set Gr2Dup = Nothing
    Set Gr3Dup = Nothing
    Set Gr4Dup = Nothing
    Set Gr5Dup = Nothing
    Set Gr6Dup = Nothing
    Set GrGroup = Nothing
    Set GrGearContour = Nothing

End Sub
Private Sub Polyline50(GrSel As Graphic, UnDirection As Boolean, xBeg0 As Double, yBeg0 As Double, GrRes As Graphic)

Dim Gr As Graphic
Dim Sel As Selection
Dim SelCount As Long
    SelCount = GrSel.Graphics.Count
Dim i As Long
Dim nV As Long, j As Long
Dim xV#, yV#
Dim xj#, yj#, zj#, xj1#, yj1#, zj1#
Dim GrType As String
Dim Vers As Vertices
Dim Ver0 As Vertex, Ver1 As Vertex, Ver2 As Vertex, Ver3 As Vertex
Dim VerIndex As Long
Dim VerIn As Long
        VerIn = -1
Dim xEnd#, yEnd#

'    Set GrRes = Grs.Add(, "TCW50Polyline")
    GrRes.Vertices.UseWorldCS = True
Dim hDr As Long ' Handle to active drawing
    hDr = TCWDrawingActive()
Dim GrIndex As Long
Dim hGr As Long
    GrIndex = GrRes.Index
    hGr = TCWGraphicAt(hDr, GrIndex)
Dim hVer As Long
'Dim ArcEnds(100) As Long, NumEnds As Long
' Dim PolyArc As ArcData
' Dim Icen As Long
' Dim DataArc(10)

    Set Gr = GrSel.Graphics(0)
    GrType = Gr.Type
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
' GRAPHIC  GRAPHIC  GRAPHIC  GRAPHIC  GRAPHIC  GRAPHIC  GRAPHIC
    If GrType = "GRAPHIC" Then
        Set Vers = Gr.Vertices
        With Vers
            xj = .Item(0).x
            yj = .Item(0).y
            xj1 = .Item(1).x
            yj1 = .Item(1).y
            If Abs(xj - xBeg0) < Eps And Abs(yj - yBeg0) < Eps Then
                GrRes.Vertices.Add xj, yj, 0
                GrRes.Vertices.Add xj1, yj1, 0

                xEnd = xj1
                yEnd = yj1
            Else
                GrRes.Vertices.Add xj1, yj1, zj1
                GrRes.Vertices.Add xj, yj, zj

                xEnd = xj
                yEnd = yj
            End If
        End With
    End If
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
' ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC
' Circle Arc

     If GrType = "ARC" Then
Dim xc#, yc#, x1#, y1#, x2#, y2#, R#, xMid#, yMid#, xDir#, yDir#
Dim Rot%
        Set Vers = Gr.Vertices
        With Vers
            x1 = .Item(1).x
            y1 = .Item(1).y
            x2 = .Item(2).x
            y2 = .Item(2).y
            xc = .Item(0).x
            yc = .Item(0).y
            xDir = .Item(3).x
            yDir = .Item(3).y

            R = Sqr((x1 - xc) * (x1 - xc) + (y1 - yc) * (y1 - yc))
            Rot = ArcRotation(x1, y1, xDir, yDir, xc, yc, R)
            Call ArcMiddlePoint(xc, yc, x1, y1, x2, y2, R, Rot, xMid, yMid)

            If Abs(x1 - xBeg0) < Eps And Abs(y1 - yBeg0) < Eps Then
                GrRes.Vertices.Add x1, y1, 0

                Set Ver0 = GrRes.Vertices.Add(xc, yc, 0)
                Ver0.Bulge = True

                Set Ver0 = GrRes.Vertices.Add(xMid, yMid, 0)
                Ver0.Bulge = True

                Set Ver0 = GrRes.Vertices.Add(x2, y2, 0)

                xEnd = x2
                yEnd = y2
            Else
                GrRes.Vertices.Add x2, y2, 0

                Set Ver0 = GrRes.Vertices.Add(xc, yc, 0)
                Ver0.Bulge = True

                Set Ver0 = GrRes.Vertices.Add(xMid, yMid, 0)
                Ver0.Bulge = True

                Set Ver0 = GrRes.Vertices.Add(x1, y1, 0)

                xEnd = x1
                yEnd = y1
            End If
        End With
    End If

'#####################################################################
'#####################################################################
'#####################################################################

    For i = 1 To SelCount - 1
        Set Gr = GrSel.Graphics(i)
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
' GRAPHIC GRAPHIC GRAPHIC GRAPHIC GRAPHIC GRAPHIC GRAPHIC GRAPHIC
        If Gr.Type = "GRAPHIC" Then
            Set Vers = Gr.Vertices
            With Vers
                xj = .Item(0).x
                yj = .Item(0).y
                xj1 = .Item(1).x
                yj1 = .Item(1).y
                If Abs(xj - xEnd) < Eps And Abs(yj - yEnd) < Eps Then
                    GrRes.Vertices.Add xj1, yj1, 0
                    xEnd = xj1
                    yEnd = yj1
                Else
                    GrRes.Vertices.Add xj, yj, 0
                    xEnd = xj
                    yEnd = yj
                End If
            End With
        End If
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
' ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC
         If Gr.Type = "ARC" Then

            Set Vers = Gr.Vertices
        With Vers
            x1 = .Item(1).x
            y1 = .Item(1).y
            x2 = .Item(2).x
            y2 = .Item(2).y
            xc = .Item(0).x
            yc = .Item(0).y
            xDir = .Item(3).x
            yDir = .Item(3).y

            R = Sqr((x1 - xc) * (x1 - xc) + (y1 - yc) * (y1 - yc))
            Rot = ArcRotation(x1, y1, xDir, yDir, xc, yc, R)

            Call ArcMiddlePoint(xc, yc, x1, y1, x2, y2, R, Rot, xMid, yMid)

            If Abs(x1 - xEnd) < Eps And Abs(y1 - yEnd) < Eps Then

                Set Ver0 = GrRes.Vertices.Add(xc, yc, 0)
                Ver0.Bulge = True

                Set Ver0 = GrRes.Vertices.Add(xMid, yMid, 0)
                Ver0.Bulge = True

                Set Ver0 = GrRes.Vertices.Add(x2, y2, 0)

                xEnd = x2
                yEnd = y2
            Else

                Set Ver0 = GrRes.Vertices.Add(xc, yc, 0)
                Ver0.Bulge = True

                Set Ver0 = GrRes.Vertices.Add(xMid, yMid, 0)
                Ver0.Bulge = True

                Set Ver0 = GrRes.Vertices.Add(x1, y1, 0)

                xEnd = x1
                yEnd = y1
            End If
        End With
        End If

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

    Next i
    If Abs(xBeg0 - xEnd) < Eps And Abs(yBeg0 - yEnd) < Eps Then
        GrRes.Closed = True
    End If

    GrRes.Update
'    GrRes.Select
    TCWUndoRecordStart hDr, "Add GearContour"
    GrIndex = GrRes.Index
    hGr = TCWGraphicAt(hDr, GrIndex)
    TCWUndoRecordAddGraphic hDr, hGr
    TCWUndoRecordEnd hDr
    GrSel.Deleted = True

'    Set GrArc1 = Nothing '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'    Set PicRes1 = Nothing '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    Set Ver0 = Nothing
    Set Ver1 = Nothing
    Set Ver2 = Nothing
    Set Ver3 = Nothing
    Set Vers = Nothing

    Set Gr = Nothing
    Set Sel = Nothing

End Sub
'This macros defines  index of all Polyline's arcs Middle points
Private Sub PolyLineArcCenterPoints(Gr As Graphic, PolyArc As ArcData)

Dim GrCosm As Graphic

Dim nV As Long, i As Long
Dim Vers As Vertices
Dim xi0#, yi0#, xi1#, yi1#, xi2#, yi2#, xi3#, yi3#

Dim nVCosm As Long, j As Long
Dim VersCosm As Vertices
Dim xj0#, yj0#, xj1#, yj1#
    Set Vers = Gr.Vertices
    Vers.UseWorldCS = True
    nV = Vers.Count
    PolyArc.NumCen = 0
    Set GrCosm = Gr.Graphics(0)
    Set VersCosm = GrCosm.Vertices
    nVCosm = VersCosm.Count
Dim j0 As Long
    j0 = 0
Dim VerBase As SelInfo
    VerBase.nV = nV
ReDim VerBase.xV(nV)
ReDim VerBase.yV(nV)
    With Vers
        For i = 0 To nV - 1
            VerBase.xV(i) = .Item(i).x
            VerBase.yV(i) = .Item(i).y
        Next i
    End With

Dim VerCosm As SelInfo
    VerCosm.nV = nVCosm
ReDim VerCosm.xV(nVCosm)
ReDim VerCosm.yV(nVCosm)
    With VersCosm
        For i = 0 To nVCosm - 1
            VerCosm.xV(i) = .Item(i).x
            VerCosm.yV(i) = .Item(i).y
        Next i
    End With
Dim k As Long, kMid As Long
Dim xMid#, yMid#

        i = 0
LBEG:
        xi0 = VerBase.xV(i)
        yi0 = VerBase.yV(i)
        xi1 = VerBase.xV(i + 1)
        yi1 = VerBase.yV(i + 1)
        For j = 0 To nVCosm - 2
            xj0 = VerCosm.xV(j)
            yj0 = VerCosm.yV(j)
            xj1 = VerCosm.xV(j + 1)
            yj1 = VerCosm.yV(j + 1)
            If Abs(xi0 - xj0) < Eps And Abs(yi0 - yj0) < Eps Then
                If Abs(xi1 - xj1) < Eps And Abs(yi1 - yj1) < Eps Then
                ' Line Segment
                    i = i + 1
                    If i = VerBase.nV - 1 Then
                        GoTo LEnd
                    Else
                        GoTo LBEG
                    End If
                Else
                ' Arc Segment
                    xi2 = VerBase.xV(i + 2)
                    yi2 = VerBase.yV(i + 2)
                    xi3 = VerBase.xV(i + 3)
                    yi3 = VerBase.yV(i + 3)
                    PolyArc.ArcCen(PolyArc.NumCen) = i + 1
 '                   NumEnds = NumEnds + 1
                    i = i + 3
                    For k = 0 To nVCosm - 1
                        xj0 = VerCosm.xV(k)
                        yj0 = VerCosm.yV(k)
                        If Abs(xi3 - xj0) < Eps And Abs(yi3 - yj0) < Eps Then
                            kMid = CLng((k + j) / 2)
                            xMid = VerCosm.xV(kMid)
                            yMid = VerCosm.yV(kMid)
                        End If
                    Next k
                    PolyArc.xMid(PolyArc.NumCen) = xMid
                    PolyArc.yMid(PolyArc.NumCen) = yMid
                    PolyArc.NumCen = PolyArc.NumCen + 1

                    If i = VerBase.nV - 1 Then
                        GoTo LEnd
                    Else
                        GoTo LBEG
                    End If
                End If
            End If
        Next j
LEnd:
    Set VersCosm = Nothing
    Set Vers = Nothing
    Set GrCosm = Nothing

End Sub

Sub TeethInvol()
Dim Gr As Graphic

Dim PressureAngle#  ' Pressure Angle
    PressureAngle = CDbl(frmGearContour.PressureAngle.Text) / 180 * Pi
Dim DiaPitch#   'Diametral Pitch
    DiaPitch = CDbl(frmGearContour.DiamPitch.Text)
Dim NumTeeth As Long 'Number of Teeth on Gear
    NumTeeth = 20
    NumTeeth = CInt(frmGearContour.TeethCount.Text)

Dim BulgePoly As Boolean
Dim GrGroup As Graphic
    If frmGearContour.Option1 = True Then
        BulgePoly = False
    Else
        BulgePoly = True
        Set GrGroup = Grs.Add(11)
    End If

Dim Rb#, R#, R0#, RR#, b#
    ' Rb - Base Circle Radius
    ' R - Pitch Radius
    ' R0 - Outside Radius
    ' RR - Root Radius
    ' b - Dedendum

    R = NumTeeth / (2 * DiaPitch)
'    R = 3
    Rb = R * Cos(PressureAngle)

    b = 1.25 / DiaPitch
    R0 = (NumTeeth + 2) / (2 * DiaPitch)
    RR = R - b
Dim xc#, yc#
    xc = xcWorld
    yc = ycWorld

'    Set Gr = Grs.AddCircleCenterAndPoint(xc, yc, 0, xc + R, yc, 0) 'Pitch Circle
'    Gr.Properties("PenColor") = RGB(255, 0, 0)
'    Gr.Draw
'    Set Gr = Grs.AddCircleCenterAndPoint(xc, yc, 0, xc + R0, yc, 0) 'Outside Circle
'    Gr.Properties("PenColor") = RGB(0, 255, 0)
'    Gr.Draw
'    Set Gr = Grs.AddCircleCenterAndPoint(xc, yc, 0, xc + Rb, yc, 0) 'Base Circle
'    Gr.Properties("PenColor") = RGB(0, 0, 255)
'    Gr.Draw
'    Set Gr = Grs.AddCircleCenterAndPoint(xc, yc, 0, xc + RR, yc, 0) 'Root Circle
'    Gr.Properties("PenColor") = RGB(0, 0, 0)
'    Gr.Draw

    ' Calculate points of involute

Dim fi#, dfi#, fi0#, fiE#, fiPrev#, fiNext#
    fi0 = 0
    dfi = Pi / 10000
Dim xi#, yi#, ri#, rNext#, rPrev#
    rPrev = Rb

    If RR > Rb Then ' Define fi0
        For fi = 0 To Pi / 2 Step dfi ' Define fiE
            xi = xc + Rb * (Cos(fi) + fi * Sin(fi))
            yi = yc + Rb * (Sin(fi) - fi * Cos(fi))
            ri = Sqr((xi - xc) * (xi - xc) + (yi - yc) * (yi - yc))
            If ri > RR Then
                rNext = ri
                fiNext = fi
                fiPrev = fiNext - dfi
                Exit For
            End If
            rPrev = ri
        Next fi
        fi0 = fiPrev + dfi * (RR - rPrev) / (rNext - rPrev)
    End If

    For fi = fi0 To Pi / 2 Step dfi ' Define fiE
        xi = xc + Rb * (Cos(fi) + fi * Sin(fi))
        yi = yc + Rb * (Sin(fi) - fi * Cos(fi))
        ri = Sqr((xi - xc) * (xi - xc) + (yi - yc) * (yi - yc))
        If ri > R0 Then
            rNext = ri
            fiNext = fi
            fiPrev = fiNext - dfi
            Exit For
        End If
        rPrev = ri
    Next fi
    fiE = fiPrev + dfi * (R0 - rPrev) / (rNext - rPrev)

Dim i As Long, nDiv As Long

    nDiv = 10
Dim xT() As Double
ReDim xT(nDiv)
Dim yT() As Double
ReDim yT(nDiv)

    dfi = (fiE - fi0) / nDiv
    For i = 0 To nDiv
        fi = fi0 + dfi * i
        xi = xc + Rb * (Cos(fi) + fi * Sin(fi))
        yi = yc + Rb * (Sin(fi) - fi * Cos(fi))
        xT(i) = xi
        yT(i) = yi
    Next i

'############################################################################
'############################################################################
' Approximate Involute as Arc
Dim xR#, yR#, xB#, yB#, xE#, yE#, L#, sina#, cosa#, xInt1#, yInt1#, xInt2#, yInt2#
Dim L1#, L2#
Dim iMax As Long, yLocInv#, yLocMax#
    If BulgePoly = True Then
        yLocMax = -100000000
        xB = xT(0)
        yB = yT(0)
        xE = xT(nDiv)
        yE = yT(nDiv)

        L = Sqr((xE - xB) ^ 2 + (yE - yB) ^ 2)
        sina = (yE - yB) / L
        cosa = (xE - xB) / L
        For i = 1 To nDiv - 1
            yLocInv = (yT(i) - yB) * cosa - (xT(i) - xB) * sina
            If Abs(yLocInv) > yLocMax Then
                yLocMax = Abs(yLocInv)
                iMax = i
            End If
        Next i
Dim GrInv0 As Graphic
        Set GrInv0 = Grs.AddArcTriplePoint(xT(0), yT(0), 0, xT(iMax), yT(iMax), 0, xT(nDiv), yT(nDiv), 0)
        GrInv0.Properties("PenColor") = RGB(255, 0, 0)
    End If
'############################################################################
'############################################################################

    ' Add line segment from involute to Root Circle
    If RR < Rb Then
        xB = xT(0)
        yB = yT(0)
        xE = xT(1)
        yE = yT(1)
        L = Sqr((xE - xB) * (xE - xB) + (yE - yB) * (yE - yB))
        sina = (yE - yB) / L
        cosa = (xE - xB) / L
        Call LineCircIntersection(xB, yB, sina, cosa, xc, yc, RR, xInt1, yInt1, xInt2, yInt2)
        L1 = Sqr((xInt1 - xB) * (xInt1 - xB) + (yInt1 - yB) * (yInt1 - yB))
        L2 = Sqr((xInt2 - xB) * (xInt2 - xB) + (yInt2 - yB) * (yInt2 - yB))
        If L1 > L2 Then
            xB = xInt2
            yB = yInt2
        Else
            xB = xInt1
            yB = yInt1
        End If
ReDim Preserve xT(nDiv + 1)
ReDim Preserve yT(nDiv + 1)
        For i = nDiv To 0 Step -1
            xT(i + 1) = xT(i)
            yT(i + 1) = yT(i)
        Next i
        xT(0) = xB
        yT(0) = yB
        nDiv = nDiv + 1
' #############################################################################
' #############################################################################
        If BulgePoly = True Then
        'Add First Line
Dim GrLine0 As Graphic
            Set GrLine0 = Grs.AddLineSingle(xT(0), yT(0), 0, xT(1), yT(1), 0)
            GrLine0.Properties("PenColor") = RGB(255, 0, 0)
        End If
' #############################################################################
' #############################################################################

    End If

    ' Add Bottom Arc Points
Dim CircPitch#  ' Circular Pitch
    CircPitch = 2 * Pi * R / NumTeeth
Dim AngPitch#
    AngPitch = 2 * Pi / NumTeeth
Dim Ang0#
    sina = (yT(0) - yc) / RR
    cosa = (xT(0) - xc) / RR
    Ang0 = Angle(sina, cosa)
Dim AngMid#, xMid#, yMid#, xiPrev#, yiPrev#, xiNext#, yiNext#
    dfi = Pi / 10000
    For fi = fi0 To Pi / 2 Step dfi ' Define fiE
        xi = xc + Rb * (Cos(fi) + fi * Sin(fi))
        yi = yc + Rb * (Sin(fi) - fi * Cos(fi))
        ri = Sqr((xi - xc) * (xi - xc) + (yi - yc) * (yi - yc))
        If ri > R Then
            rNext = ri
            xiNext = xi
            yiNext = yi
            Exit For
        End If
        rPrev = ri
        xiPrev = xi
        yiPrev = yi
    Next fi
    xMid = xiPrev + (xiNext - xiPrev) * (R - rPrev) / (rNext - rPrev)
    yMid = yiPrev + (yiNext - yiPrev) * (R - rPrev) / (rNext - rPrev)
    sina = (yMid - yc) / R
    cosa = (xMid - xc) / R
    AngMid = Angle(sina, cosa)
    If Ang0 > AngMid Then
        Ang0 = Ang0 - 2 * Pi
    End If
Dim Ang1#
    Ang1 = AngMid - AngPitch / 4
Dim ArcDiv As Long, j As Long
    ArcDiv = 2
    dfi = (Ang0 - Ang1) / ArcDiv
    For i = 1 To ArcDiv
        fi = Ang0 - i * dfi
        xi = xc + RR * Cos(fi)
        yi = yc + RR * Sin(fi)
ReDim Preserve xT(nDiv + 1)
ReDim Preserve yT(nDiv + 1)
        For j = nDiv To 0 Step -1
            xT(j + 1) = xT(j)
            yT(j + 1) = yT(j)
        Next j
        xT(0) = xi
        yT(0) = yi
        nDiv = nDiv + 1
    Next i

'##########################################################################
'##########################################################################
    If BulgePoly = True Then
        'Add Bottom arc
Dim GrArcBot As Graphic
        xB = xc + RR * Cos(Ang0)
        yB = yc + RR * Sin(Ang0)
        xMid = xc + RR * Cos(Ang1)
        yMid = yc + RR * Sin(Ang1)
        xE = xc + RR * Cos(Ang1 - Abs(Ang0 - Ang1))
        yE = yc + RR * Sin(Ang1 - Abs(Ang0 - Ang1))

        Set GrArcBot = Grs.AddArcTriplePoint(xB, yB, 0, xMid, yMid, 0, xE, yE, 0)
        GrArcBot.Properties("PenColor") = RGB(255, 0, 0)

        ' Duplicate Line and InvoluteCurve
Dim GrLine1 As Graphic
        Set GrLine1 = GrLine0.Duplicate
        GrLine1.RotateAxis Pi, Cos(Ang1), Sin(Ang1), 0, xc, yc, 0
Dim GrInv1 As Graphic
        Set GrInv1 = GrInv0.Duplicate
        GrInv1.RotateAxis Pi, Cos(Ang1), Sin(Ang1), 0, xc, yc, 0
    End If
'##########################################################################
'##########################################################################

    ' Add Top Arc Points
    sina = (yT(nDiv) - yc) / R0
    cosa = (xT(nDiv) - xc) / R0
    Ang0 = Angle(sina, cosa)
    Ang1 = AngMid + AngPitch / 4
    dfi = (Ang1 - Ang0) / ArcDiv
    For i = 1 To ArcDiv
        fi = Ang0 + i * dfi
        xi = xc + R0 * Cos(fi)
        yi = yc + R0 * Sin(fi)
ReDim Preserve xT(nDiv + 1)
ReDim Preserve yT(nDiv + 1)
        nDiv = nDiv + 1
        xT(nDiv) = xi
        yT(nDiv) = yi
    Next i

'##########################################################################
'##########################################################################
    If BulgePoly = True Then
        'Add Top arc
Dim GrArcTop As Graphic
        xB = xc + R0 * Cos(Ang0)
        yB = yc + R0 * Sin(Ang0)
        xMid = xc + R0 * Cos(Ang1)
        yMid = yc + R0 * Sin(Ang1)
        xE = xc + R0 * Cos(Ang1 + Abs(Ang0 - Ang1))
        yE = yc + R0 * Sin(Ang1 + Abs(Ang0 - Ang1))

        Set GrArcTop = Grs.AddArcTriplePoint(xB, yB, 0, xMid, yMid, 0, xE, yE, 0)
        GrArcTop.Properties("PenColor") = RGB(255, 0, 0)

        Grs.Remove GrInv1.Index
        GrGroup.Graphics.AddGraphic GrInv1

        Grs.Remove GrLine1.Index
        GrGroup.Graphics.AddGraphic GrLine1

        Grs.Remove GrArcBot.Index
        GrGroup.Graphics.AddGraphic GrArcBot

        Grs.Remove GrLine0.Index
        GrGroup.Graphics.AddGraphic GrLine0

        Grs.Remove GrInv0.Index
        GrGroup.Graphics.AddGraphic GrInv0

        Grs.Remove GrArcTop.Index
        GrGroup.Graphics.AddGraphic GrArcTop

        Set GrArcTop = Nothing
        Set GrInv0 = Nothing
        Set GrLine0 = Nothing
        Set GrLine1 = Nothing
        Set GrInv1 = Nothing
        Set GrArcBot = Nothing
   End If
'##########################################################################
'##########################################################################

'###########################################################################
' Define the bottom fillet
Dim x1#, y1#, x2#, y2#, x3#, y3#, rFillet#
Dim xLoc#, yLoc#, Bet#, sinb#, cosb#
    x1 = xT(1)
    y1 = yT(1)
    x2 = xT(2)
    y2 = yT(2)
    x3 = xT(3)
    y3 = yT(3)
    L1 = Sqr((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1))
    L2 = Sqr((x3 - x2) * (x3 - x2) + (y3 - y2) * (y3 - y2))
    If L2 > L1 Then
        rFillet = L1 / 2
    Else
        If L2 > L1 / 2 Then
            rFillet = L1 / 2
        Else
            rFillet = 0.8 * L2
        End If
    End If
    sina = (y1 - y2) / L1
    cosa = (x1 - x2) / L1
    yLoc = (y3 - y2) * cosa - (x3 - x2) * sina
    xLoc = (y3 - y2) * sina + (x3 - x2) * cosa
    sinb = Abs(yLoc) / L2
    cosb = Abs(xLoc) / L2
    Bet = Pi - Angle(sinb, cosb)
    xLoc = rFillet / Tan(Bet / 2)
    yLoc = rFillet
Dim xcFillet#, ycFillet#
    xcFillet = x2 + xLoc * cosa - yLoc * sina
    ycFillet = y2 + xLoc * sina + yLoc * cosa
Dim xLast#, yLast#, xFirst#, yFirst#
    yLoc = 0
    xLast = x2 + xLoc * cosa - yLoc * sina
    yLast = y2 + xLoc * sina + yLoc * cosa
    L1 = Sqr((x2 - xcFillet) * (x2 - xcFillet) + (y2 - ycFillet) * (y2 - ycFillet))
    sina = (y2 - ycFillet) / L1
    cosa = (x2 - xcFillet) / L1
    xLoc = rFillet
    yLoc = 0
    xMid = xcFillet + xLoc * cosa - yLoc * sina
    yMid = ycFillet + xLoc * sina + yLoc * cosa
    sina = (y3 - y2) / L2
    cosa = (x3 - x2) / L2
    xLoc = rFillet / Tan(Bet / 2)
    yLoc = 0
    xFirst = x2 + xLoc * cosa - yLoc * sina
    yFirst = y2 + xLoc * sina + yLoc * cosa

    xT(ArcDiv) = xFirst
    yT(ArcDiv) = yFirst

ReDim Preserve xT(nDiv + 1)
ReDim Preserve yT(nDiv + 1)
        For j = nDiv To 2 Step -1
            xT(j + 1) = xT(j)
            yT(j + 1) = yT(j)
        Next j
        xT(ArcDiv) = xMid
        yT(ArcDiv) = yMid
        nDiv = nDiv + 1
ReDim Preserve xT(nDiv + 1)
ReDim Preserve yT(nDiv + 1)
        For j = nDiv To 2 Step -1
            xT(j + 1) = xT(j)
            yT(j + 1) = yT(j)
        Next j
        xT(ArcDiv) = xLast
        yT(ArcDiv) = yLast
        nDiv = nDiv + 1

'###########################################################################
' Form theProfile for Single Teeth
ReDim Preserve xT(2 * nDiv)
ReDim Preserve yT(2 * nDiv)
Dim nDiv0 As Long
    nDiv0 = nDiv
    xi = xT(nDiv)
    yi = yT(nDiv)
    ri = Sqr((xi - xc) * (xi - xc) + (yi - yc) * (yi - yc))
    sina = (yi - yc) / ri
    cosa = (xi - xc) / ri
    fi0 = Angle(sina, cosa)

    For i = nDiv0 - 1 To 0 Step -1
        xi = xT(i)
        yi = yT(i)
        ri = Sqr((xi - xc) * (xi - xc) + (yi - yc) * (yi - yc))
        sina = (yi - yc) / ri
        cosa = (xi - xc) / ri
        fi = Angle(sina, cosa)
        If fi > Pi Then
            fi = fi - 2 * Pi
        End If
        dfi = fi - fi0
        dfi = -dfi
        fi = fi0 + dfi
        xi = xc + ri * Cos(fi)
        yi = yc + ri * Sin(fi)
        nDiv = nDiv + 1
        xT(nDiv) = xi
        yT(nDiv) = yi
    Next i
    ' Polar cordinate for single Teeth
Dim fiT() As Double
Dim rT() As Double
ReDim fiT(2 * nDiv)
ReDim rT(2 * nDiv)
    For i = 0 To nDiv
        xi = xT(i)
        yi = yT(i)
        ri = Sqr((xi - xc) * (xi - xc) + (yi - yc) * (yi - yc))
        sina = (yi - yc) / ri
        cosa = (xi - xc) / ri
        fi = Angle(sina, cosa)
        fiT(i) = fi
        rT(i) = ri
    Next i

    nDiv0 = nDiv
ReDim Preserve xT(2 * nDiv * NumTeeth)
ReDim Preserve yT(2 * nDiv * NumTeeth)
ReDim Preserve fiT(2 * nDiv * NumTeeth)
ReDim Preserve rT(2 * nDiv * NumTeeth)

    For i = 1 To NumTeeth - 1
        dfi = AngPitch * i
        For j = 1 To nDiv0
            ri = rT(j)
            fi = fiT(j)
            fi = fi + dfi
            xi = xc + ri * Cos(fi)
            yi = yc + ri * Sin(fi)
            nDiv = nDiv + 1
            xT(nDiv) = xi
            yT(nDiv) = yi
        Next j
    Next i

    If BulgePoly = False Then
        Set Gr = Grs.Add(imsiPolyline)
        With Gr.Vertices
            For i = 0 To nDiv - 1
                xi = xT(i)
                yi = yT(i)
                .Add xi, yi, 0
            Next i
            .AddClose
        End With
    End If
'#####################################################################
'#####################################################################
    If BulgePoly = True Then
        ' Add Full Gear contour as couple of Arcs and lines
Dim GrGroupCount As Long
        GrGroupCount = GrGroup.Graphics.Count
Dim GrDup As Graphic
        With GrGroup.Graphics
            For i = 1 To NumTeeth - 1
                dfi = AngPitch * i
                For j = 0 To GrGroupCount - 1
                    Set GrDup = .Item(j).Duplicate
                    GrDup.RotateAxis dfi, 0, 0, 1, xc, yc, 0
                    .Remove GrDup.Index
                    .AddGraphic GrDup
                Next j
            Next i
        End With
Dim xBeg0#, yBeg0#
        Set GrDup = GrGroup.Graphics(0)
        xBeg0 = GrDup.Vertices(2).x
        yBeg0 = GrDup.Vertices(2).y

Dim GrGearContour As Graphic
        Set GrGearContour = Grs.Add(, "TCW50Polyline")
        Call Polyline50(GrGroup, False, xBeg0, yBeg0, GrGearContour)

        Set GrDup = Nothing
        Set GrGroup = Nothing
    End If
    If frmGearContour.Check1.Value = 1 Then
        FileWrite = False
        frmSaveFile.Show 1
        If FileWrite = True Then
Dim FilePath$
            FilePath = frmSaveFile.PathFile
            Open FilePath For Output As #1
Dim nV As Long
Dim Str$
            If BulgePoly = True Then
                With GrGearContour.Graphics(0).Vertices
                    nV = .Count
                    Str = "Gear Contour"
                    Print #1, Str
                    Str = "Point count = " & CStr(nV)
                    Print #1, Str
                    For i = 0 To nV - 1
                        xi = .Item(i).x
                        yi = .Item(i).y
                        Str = "G1" & "X" & Format(xi, "###0.0000") & "Y" & Format(yi, "###0.0000")
                        Print #1, Str
                    Next i
                End With
            Else
                With Gr.Vertices
                    nV = .Count
                    Str = "Gear Contour"
                    Print #1, Str
                    Str = "Point count = " & CStr(nV)
                    Print #1, Str
                    For i = 0 To nV - 1
                        xi = .Item(i).x
                        yi = .Item(i).y
                        Str = "G1" & "X" & Format(xi, "###0.0000") & "Y" & Format(yi, "###0.0000")
                        Print #1, Str
                    Next i
                End With
            End If
            Close #1
        End If
    End If

    Set GrGearContour = Nothing

'#####################################################################
'#####################################################################
End Sub
Private Function LineCircIntersection(x1 As Double, y1 As Double, sina As Double, cosa As Double, xc As Double, yc As Double, R As Double, xInt1 As Double, yInt1 As Double, xInt2 As Double, yInt2 As Double) As Boolean
Dim xcLoc#, ycLoc#
    xcLoc = (yc - y1) * sina + (xc - x1) * cosa
    ycLoc = (yc - y1) * cosa - (xc - x1) * sina
    If Abs(ycLoc) > Abs(R) + Eps Then
        LineCircIntersection = False
        Exit Function
    End If
Dim t#
    t = Sqr(Abs(R * R - ycLoc * ycLoc))
Dim xLoc#, yLoc#
    yLoc = 0
    xLoc = xcLoc + t
    xInt1 = x1 + xLoc * cosa - yLoc * sina
    yInt1 = y1 + xLoc * sina + yLoc * cosa

    xLoc = xcLoc - t
    xInt2 = x1 + xLoc * cosa - yLoc * sina
    yInt2 = y1 + xLoc * sina + yLoc * cosa
    LineCircIntersection = True
End Function

Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function

' Define the middle point of Base Arc
' from Beg-End Points and Rot
' Rot=1 - Counter Clockwise
' Rot=-1 - Clockwise
Private Sub ArcMiddlePoint(xc As Double, yc As Double, xB As Double, yB As Double, xE As Double, yE As Double, R As Double, Rot As Integer, xMid As Double, yMid As Double)
    If Abs(R) < Eps Then
        xMid = xc
        yMid = yc
        Exit Sub
    End If

Dim sina#, cosa#
Dim fiBeg#, fiEnd#, fiMid#
    sina = (yB - yc) / R
    cosa = (xB - xc) / R
    fiBeg = Angle(sina, cosa)

    sina = (yE - yc) / R
    cosa = (xE - xc) / R
    fiEnd = Angle(sina, cosa)

    If Rot = 1 Then ' Counter Clockwise
        If fiBeg > fiEnd Then fiEnd = fiEnd - 2 * Pi
    Else    'Clockwise
        If fiBeg < fiEnd Then fiEnd = fiEnd - 2 * Pi
    End If

    fiMid = (fiBeg + fiEnd) / 2
    xMid = xc + R * Cos(fiMid)
    yMid = yc + R * Sin(fiMid)

End Sub

' Define the direction of Arc rotation
' return ArcRotation = 1 if CounterClockwise
' return ArcRotation = -1 if Clockwise

Private Function ArcRotation(xB As Double, yB As Double, xDir As Double, yDir As Double, xc As Double, yc As Double, R As Double) As Integer
Dim sina#, cosa# ', Alp0#, Alp1#
    sina = (yB - yc) / R
    cosa = (xB - xc) / R
Dim xLoc#, yLoc#
    xLoc = (yDir - yc) * sina + (xDir - xc) * cosa
    yLoc = (yDir - yc) * cosa - (xDir - xc) * sina
    If yLoc > 0 Then
        ArcRotation = 1
    Else
        ArcRotation = -1
    End If
End Function


Examples - Gear Contour Tool - GearContour.frm

GearContour.frm

Gear Contour Tool Example

VERSION 5.00
Begin VB.Form frmGearContour
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Gear Parameters-Demo"
   ClientHeight    =   4815
   ClientLeft      =   30
   ClientTop       =   270
   ClientWidth     =   3375
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4815
   ScaleWidth      =   3375
   StartUpPosition =   3  'Windows Default
   Begin VB.CheckBox Check1
      Caption         =   "Create CNC File"
      Height          =   252
      Left            =   1080
      TabIndex        =   11
      Top             =   3240
      Width           =   1572
   End
   Begin VB.CommandButton CmdCancel
      Caption         =   "Cancel"
      Height          =   372
      Left            =   840
      TabIndex        =   10
      Top             =   4320
      Width           =   1452
   End
   Begin VB.Frame Frame1
      Caption         =   "Contour Presentation"
      Height          =   1212
      Left            =   1080
      TabIndex        =   7
      Top             =   1800
      Width           =   2052
      Begin VB.OptionButton Option2
         Caption         =   "Polyline with Arcs"
         Height          =   372
         Left            =   240
         TabIndex        =   9
         Top             =   720
         Width           =   1692
      End
      Begin VB.OptionButton Option1
         Caption         =   "Simple Polyline"
         Height          =   252
         Left            =   240
         TabIndex        =   8
         Top             =   360
         Value           =   -1  'True
         Width           =   1572
      End
   End
   Begin VB.CommandButton CmdOk
      Caption         =   "Ok"
      Height          =   372
      Left            =   840
      TabIndex        =   6
      Top             =   3720
      Width           =   1452
   End
   Begin VB.TextBox PressureAngle
      Height          =   288
      Left            =   2400
      TabIndex        =   5
      Text            =   "20"
      Top             =   1320
      Width           =   732
   End
   Begin VB.TextBox DiamPitch
      Height          =   288
      Left            =   2400
      TabIndex        =   3
      Text            =   "2"
      Top             =   840
      Width           =   732
   End
   Begin VB.TextBox TeethCount
      Height          =   288
      Left            =   2400
      TabIndex        =   1
      Text            =   "20"
      Top             =   360
      Width           =   732
   End
   Begin VB.Label Label3
      Caption         =   "Pressure Angle"
      Height          =   252
      Left            =   1080
      TabIndex        =   4
      Top             =   1320
      Width           =   1212
   End
   Begin VB.Label Label2
      Caption         =   "Diamtral Pitch"
      Height          =   252
      Left            =   1200
      TabIndex        =   2
      Top             =   840
      Width           =   1092
   End
   Begin VB.Label Label1
      Caption         =   "Number of Teeth (10<nz<30)"
      Height          =   252
      Left            =   240
      TabIndex        =   0
      Top             =   360
      Width           =   2052
   End
End
Attribute VB_Name = "frmGearContour"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CmdCancel_Click()
    Me.Hide
End Sub

Private Sub CmdOk_Click()
    Me.Hide
    ParamCanc = False
End Sub


Examples - Gear Contour Tool - SaveFile.frm

SaveFile.frm

Gear Contour Tool Example

VERSION 5.00
Begin VB.Form frmSaveFile
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Save File As"
   ClientHeight    =   3495
   ClientLeft      =   30
   ClientTop       =   270
   ClientWidth     =   4230
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3495
   ScaleWidth      =   4230
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton CmdCancel
      Caption         =   "Cancel"
      Height          =   372
      Left            =   2760
      TabIndex        =   5
      Top             =   2400
      Width           =   1212
   End
   Begin VB.CommandButton CmdOk
      Caption         =   "Ok"
      Height          =   372
      Left            =   2760
      TabIndex        =   4
      Top             =   1920
      Width           =   1212
   End
   Begin VB.TextBox PathFile
      Height          =   372
      Left            =   120
      TabIndex        =   3
      Top             =   3000
      Width           =   3972
   End
   Begin VB.FileListBox File1
      Height          =   870
      Left            =   120
      TabIndex        =   2
      Top             =   1800
      Width           =   1932
   End
   Begin VB.DirListBox Dir1
      Height          =   1152
      Left            =   120
      TabIndex        =   1
      Top             =   600
      Width           =   1932
   End
   Begin VB.DriveListBox Drive1
      Height          =   288
      Left            =   120
      TabIndex        =   0
      Top             =   240
      Width           =   1932
   End
End
Attribute VB_Name = "frmSaveFile"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private MyDrive$
Private MyDir$
Private MyFile$
Private MyPath$

Private Sub CmdCancel_Click()
    Me.Hide
End Sub

Private Sub CmdOk_Click()
    FileWrite = True
    Me.Hide
End Sub

Private Sub Form_Load()
    PathFile.Text = ""
End Sub
Private Sub Dir1_Change()
    File1.Path = Dir1.Path
    MyDir = Dir1.Path
    PathFile.Text = MyDir & "\"
'MsgBox ("111111   " & PathFile.Text)
End Sub

Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
    MyDrive = Drive1.Drive
'    PathFile.Text = Dir1.Path & "\"
End Sub

Private Sub File1_Click()
    MyPath = File1.Path
    MyFile = File1.FileName
    PathFile.Text = MyPath & "\" & MyFile
End Sub


Examples - Internet Hyperlink Tool - Inet.bas

Inet.bas

Internet Hyperlink Tool Example

Attribute VB_Name = "modInet"
Option Explicit
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Declare Function WinExec Lib "kernel32" (ByVal lpCmdLine As String, ByVal nCmdShow As Long) As Long
Const SYNCHRONIZE = &H100000
Const READ_CONTROL = &H20000
Const STANDARD_RIGHTS_READ = (READ_CONTROL)
Const STANDARD_RIGHTS_WRITE = (READ_CONTROL)
Const STANDARD_RIGHTS_ALL = &H1F0000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Public Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const ERROR_NONE = 0
Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
Public Const SW_SHOW = 5

Sub Main()

End Sub


Examples - Internet Hyperlink Tool - Inet.cls

Inet.cls

Internet Hyperlink Tool Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Inet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'Number of tools in this server
Const NUM_TOOLS = 1

'Toggle this to test loading buttons from .Bmp/.Res
Const boolLoadFromBmp As Boolean = False
Const boolDebug As Boolean = False

'Return a description string for this package of tools
Public Property Get Description() As String
    Description = "Internet connection tool"
End Property

'Called to perform tool function
Public Function Run(ByVal Tool As Object) As Boolean
    Dim objApp As Object
    Dim objSel As Object
    Dim objGraphic As Object
    Dim strURL As String
    On Error Resume Next

    'Look for first URL property in the selection
    Set objApp = Tool.Application
    Set objSel = objApp.Selection
    For Each objGraphic In objSel
        strURL = ""
        strURL = objGraphic.Properties("URL")
        If strURL <> "" Then
            StartBrowser strURL
            Run = True
            Exit Function
        End If
    Next objGraphic

    'No selection or no URLs: just start browser at a convenient home page
    StartBrowser "http://www.imsisoft.com/"
    Run = True
End Function

'Fill arrays with information about tools in the package
'Return the number of tools in the package
Public Function GetToolInfo(CommandNames As Variant, MenuCaptions As Variant, StatusPrompts As Variant, _
    ToolTips As Variant, Enabled As Variant, WantsUpdates As Variant) As Long
    ReDim CommandNames(NUM_TOOLS)
    ReDim MenuCaptions(NUM_TOOLS, 2)
    ReDim StatusPrompts(NUM_TOOLS)
    ReDim ToolTips(NUM_TOOLS)
    ReDim Enabled(NUM_TOOLS)
    ReDim WantsUpdates(NUM_TOOLS)
'    CommandNames(0) = "S&DK|I&nternet|Hyperlink"
    CommandNames(0) = "S&DK|Hyperlink"
    MenuCaptions(0, 0) = "&Hyperlink"
    MenuCaptions(0, 1) = "SDK" ' toolbar name
    StatusPrompts(0) = "Launch a browser on the World Wide Web"
    ToolTips(0) = "Hyperlink"
    Enabled(0) = True
    WantsUpdates(0) = False
    GetToolInfo = NUM_TOOLS
End Function

'Copy a windows bitmap of the requested size to the clipboard
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire bitmap:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono bitmap should be 1-bit (black or white)
Public Function CopyBitmap(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Boolean
    On Error GoTo BitmapError

    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        'Put the image on the Windows clipboard
        Clipboard.SetData TheImage, vbCFDIB
        CopyBitmap = True
        Exit Function
    End If

BitmapError:
    CopyBitmap = False
End Function

'Return a Picture object for the requested size
'Apparently, returning references to StdPicture objects doesn't work for .EXE servers
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire image:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono image should be 1-bit (black or white)
Public Function GetPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Object
    On Error GoTo PictureError

    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        Set GetPicture = TheImage
        Exit Function
    End If

PictureError:
    Set GetPicture = Nothing
End Function

'Returns true if tool is correctly initialized
Public Function Initialize(ByVal Tool As Object) As Boolean
    Initialize = True
End Function

'Returns true if tool is correctly initialized
Public Function UpdateToolStatus(ByVal Tool As Object, Enabled As Boolean, Checked As Boolean) As Boolean
    Enabled = True 'Could do a test here to determine whether to disable the button/menu item
    Checked = False  'Could do a test here to determine whether to check the button/menu item
    UpdateToolStatus = True
End Function

'Implementation specific stuff
'Private function to return the bitmap from .Res file or .Bmp file
Private Function GetButtonPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean, TheImage As StdPicture) As Boolean
    On Error GoTo LoadError

    'There are two ways to load images:  from .Bmp file(s) or from .RES resource.
    'In this demo, we control the loading by a private variable.

    'Note that if you are loading from .Bmp, or if you are running this tool as a
    '.VBP for debugging, you must place the .Res or .Bmp files in the Draggers subdirectory
    'of the directory in which TCW40.EXE (or IMSIGX40.DLL) is located.

    If boolLoadFromBmp Then
        'Load from .Bmp file
        Dim strFileName As String 'File name of .Bmp file to load

        If LargeImage Then
            strFileName = App.Path & "\button24.bmp"
        Else
            strFileName = App.Path & "\button16.bmp"
        End If
        Set TheImage = LoadPicture(strFileName)
    Else
        'Load from .Res file
        Dim idBitmap%  'BITMAP resource id in .Res file

        If LargeImage Then
            idBitmap% = 102
        Else
            idBitmap% = 101
        End If
        Set TheImage = LoadResPicture(idBitmap%, vbResBitmap)
    End If

    'Return the image
    GetButtonPicture = True
    Exit Function

LoadError:
    If boolDebug Then
        MsgBox "Error loading bitmap: " & Err.Description
    End If
    GetButtonPicture = False
End Function

'We get the name of the installed internet browser from the Windows registry
Private Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As String, vValue As Variant) As Long
    Dim cch As Long
    Dim lrc As Long
    Dim lType As Long
    Dim lValue As Long
    Dim sValue As String

    On Error GoTo QueryValueExError

    ' Determine the size and type of data to be read
    lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
    If lrc <> ERROR_NONE Then Error 5

    Select Case lType
        ' For strings
        Case REG_SZ:
            sValue = String(cch, 0)

            lrc = RegQueryValueExString(lhKey, szValueName, 0&, lType, sValue, cch)
            If lrc = ERROR_NONE Then
                If cch > 0 Then
                    cch = cch - 1
                End If
                vValue = Left$(sValue, cch)
            Else
                vValue = Empty
            End If
        ' For DWORDS
        Case REG_DWORD:
            lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, lValue, cch)
            If lrc = ERROR_NONE Then vValue = lValue
        Case Else
            'all other data types not supported
            lrc = -1
    End Select

QueryValueExExit:
    QueryValueEx = lrc
    Exit Function

QueryValueExError:
    Resume QueryValueExExit

End Function

'Get a string value from the registry
Private Function QueryValueString(ByVal lRootKey As Long, ByVal sKeyName As String, ByVal sValueName As String) As String
    Dim lRetVal As Long         'result of the API functions
    Dim hKey As Long         'handle of opened key
    Dim vValue As Variant      'setting of queried value

    lRetVal = RegOpenKeyEx(lRootKey, sKeyName, 0, KEY_ALL_ACCESS, hKey)
    lRetVal = QueryValueEx(hKey, sValueName, vValue)
    QueryValueString = vValue
    RegCloseKey (hKey)
End Function

'Private function to startup the registered internet browser at a specified URL
Private Function StartBrowser(strURL As String)
    Dim HRes As Long
    Dim TheKey As Long
    Dim strExec As String

    'Get the browser command from the registry
    strExec = QueryValueString(HKEY_LOCAL_MACHINE, "SOFTWARE\Classes\HTTP\shell\open\command", "")
    If strExec <> "" Then
        If strURL <> "" Then

            'Embed the URL in quotes and build a command line
            strExec = strExec & " " & Chr$(34) & strURL & Chr$(34)
        End If

        'Invoke the browser
        WinExec strExec, SW_SHOW
    End If
End Function


Examples - Joint Tool - Joint.bas

Joint.bas

Joint Tool Example

Attribute VB_Name = "modJoint"
Option Explicit

Type SelInfo
    nV As Long
    xV() As Double
    yV() As Double
End Type

Type ArcData
    NumCen As Long
    ArcCen(100) As Long
    xMid(100) As Double
    yMid(100) As Double
End Type

Global objApp As XApplication
Global Drs As Drawings
Global actDr As Drawing
Global Sel As Selection
Global Grs As Graphics
Global Gr As Graphic
Global GrRes As Graphic
Global Vis As Views
Global Vi As View
Global PRes As PickResult
Global PEnt As PickEntry
Global Const Pi = 3.14159265359
Global Const Eps = 0.000001
Global GRAPHICTYPE As String
Global ARCTYPE As String

Sub Main()
End Sub


Examples - Joint Tool - Joint.cls

Joint.cls

Joint Tool Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Polyline"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'Number of tools in this server
Const NUM_TOOLS = 1
Private GrSets As GraphicSets
Private GrSet As GraphicSet
Private SetID(1000) As Long
Private OldSetColor(1000) As Long
Private NumSetID As Long

Private PenColor As Variant
Private PenWidth As Variant
Private PenStyle As Variant

Private aa As Double
Private bb As Double
Private cc As Double

Private Captions(0 To 4) As String
Private Prompts(0 To 4, 0 To 1) As String
Private Enabled(0 To 4) As Boolean
Private Checked(0 To 4) As Boolean
Private EnableSequence As Boolean
Private OneStepBack As Boolean
Private FinishJoint As Boolean
Private DeleteObjects As Boolean

Private SelectedObjects As Boolean
' *******************************************************************
'    Const EventMask = 1024 + 2048 + 4096 + 268435456 + 536870912
'    Const EventMask = 1024 + 268435456 + 536870912
    Const EventMask = 1 + 2 + 4 + 8 + 16 + 32 + 64 + 1024 + 2048 + 8192 + 262144 + 268435456 + 536870912
    Const EventMask1 = 1 + 2 + 4 + 8 + 16 + 32 + 64 + 1024 + 2048 + 4096 + 8192 + 262144 + 268435456 + 536870912

    Private iConnectId As Long
    Private iActTool As Long
    Private theToolEvents As IToolEvents

' *******************************************************************
'Toggle this to test loading buttons from .Bmp/.Res
Const boolLoadFromBmp As Boolean = False
Const boolDebug As Boolean = False
'##########################################################################
'##########################################################################
Private Declare Function TCWViewRedraw Lib "TCAPI70.dll" () As Long
Private Declare Function TCWUndoClear Lib "TCAPI70.dll" () As Long
Private Declare Function TCWUndoRecordEnd Lib "TCAPI70.dll" (ByVal d As Long) As Long
Private Declare Function TCWUndoRecordStart Lib "TCAPI70.dll" (ByVal d As Long, ByRef title As String) As Long
Private Declare Function TCWUndoRecordAddGraphic Lib "TCAPI70.dll" (ByVal d As Long, ByVal g As Long) As Long
Private Declare Function TCWUndo Lib "TCAPI70.dll" (ByVal n As Long) As Long

Private Declare Function TCWDrawingActive Lib "TCAPI70.dll" () As Long
Private Declare Function TCWGraphicAt Lib "TCAPI70.dll" (ByVal d As Long, ByVal Index As Long) As Long
Private Declare Function TCWVertexAt Lib "TCAPI70.dll" (ByVal g As Long, ByVal Index As Long) As Long

Private Declare Sub prVertexSetSomeFlags Lib "DBAPI70.dll" (ByVal hVer As Long, ByVal FlagOn As Long, ByVal FlagOff As Long)

Private Declare Function GraphicGetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long) As Long
Private Declare Function GraphicSetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long, ByVal hMat As Long) As Boolean
Private Declare Function MatrixEqual Lib "DBAPI70.dll" (ByVal hM1 As Long, ByVal hM2 As Long) As Boolean

Private hDr As Long
Private DifferentWorkPlane As Boolean
Private hMatFirst As Long

'Copy a windows bitmap of the requested size to the clipboard
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire bitmap:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono bitmap should be 1-bit (black or white)
Public Function CopyBitmap(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Boolean
    On Error GoTo BitmapError

    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        'Put the image on the Windows clipboard
        Clipboard.SetData TheImage, vbCFDIB
        CopyBitmap = True
        Exit Function
    End If

BitmapError:
    CopyBitmap = False
End Function

'Return a Picture object for the requested size
'Apparently, returning references to StdPicture objects doesn't work for .EXE servers
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire image:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono image should be 1-bit (black or white)
Public Function GetPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Object
    On Error GoTo PictureError

    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        Set GetPicture = TheImage
        Exit Function
    End If

PictureError:
    Set GetPicture = Nothing
End Function

'Implementation specific stuff
'Private function to return the bitmap from .Res file or .Bmp file
Private Function GetButtonPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean, TheImage As StdPicture) As Boolean
    On Error GoTo LoadError

    'There are two ways to load images:  from .Bmp file(s) or from .RES resource.
    'In this demo, we control the loading by a private variable.

    'Note that if you are loading from .Bmp, or if you are running this tool as a
    '.VBP for debugging, you must place the .Res or .Bmp files in the Draggers subdirectory
    'of the directory in which TCW40.EXE (or IMSIGX40.DLL) is located.

    If boolLoadFromBmp Then
        'Load from .Bmp file
        Dim strFileName As String 'File name of .Bmp file to load

        If LargeImage Then
            strFileName = App.Path & "\button24.bmp"
        Else
            strFileName = App.Path & "\button16.bmp"
        End If
        Set TheImage = LoadPicture(strFileName)
    Else
        'Load from .Res file
        Dim idBitmap%  'BITMAP resource id in .Res file

        If LargeImage Then
            idBitmap% = 1002
        Else
            idBitmap% = 1001
        End If
        Set TheImage = LoadResPicture(idBitmap%, vbResBitmap)
    End If

    'Return the image
    GetButtonPicture = True
    Exit Function

LoadError:
    If boolDebug Then
'        MsgBox "Error loading bitmap: " & Err.Description
    End If
    GetButtonPicture = False
End Function

'Private Function GetLMPicture() As Object
Public Function GetLMPicture() As Object
Dim TheImage As StdPicture
'MsgBox ("1111")
    Set TheImage = LoadResPicture(1003, vbResBitmap)
    Set GetLMPicture = TheImage
End Function

'##########################################################################
'##########################################################################
'##########################################################################

'Return a description string for this package of tools
Public Property Get Description() As String
    Description = "JointPolyline"
End Property

'Called to perform tool function
Public Function Run(ByVal Tool As Object) As Boolean
    On Error GoTo ErrorHandler
Dim theXTool As Tool
    SelectedObjects = False
    DeleteObjects = True
    EnableSequence = True
    OneStepBack = False
    FinishJoint = False
    Set theXTool = Tool
    Set actDr = theXTool.Application.ActiveDrawing
 '   Set GrSets = actDr.GraphicSets
    Set Sel = actDr.Selection
    NumSetID = 0
Dim SelCount As Long, i As Long
    SelCount = Sel.Count
' If exist some selected objects
    If SelCount > 0 Then
        SelectedObjects = True

        EnableSequence = False
        OneStepBack = False
        FinishJoint = True
        Checked(0) = True
        Set GrSets = actDr.GraphicSets
        Set GrSet = GrSets.Add
Dim GrID As Long
        For i = 0 To SelCount - 1
            Set Gr = Sel(i)
            GrSet.AddGraphic Gr
        Next i
'        actDr.Graphics.Unselect
'        Call SelectionToGroup(GrSet)
'        TCWViewRedraw
'        GrSet.Clear
'        If iConnectId <> -1 Then
'            objApp.DisconnectEvents iConnectId
'            iConnectId = -1
'            AddLM False
'            iActTool = -1
'            theToolEvents.ToolChangePrompt Me, "", False
'        End If
'        Call Finish
'        Exit Function
    Else
        actDr.Graphics.Unselect
    End If

  ' If not exist some Selected objects
    If iConnectId <> -1 Then
        objApp.DisconnectEvents iConnectId
        AddLM False
        iConnectId = -1
        iActTool = -1
        theToolEvents.ToolChangePrompt Me, "", False
    Else
        If SelCount = 0 Then
            iConnectId = objApp.ConnectEvents(Me, EventMask)
            AddLM True
'            theToolEvents.ToolChangePrompt Me, "Pick any segment", False
            theToolEvents.ToolChangePrompt Me, LoadResString(101), False
        Else
            iConnectId = objApp.ConnectEvents(Me, EventMask1)
            AddLM True
'            theToolEvents.ToolChangePrompt Me, "Open a local menu to choose Finish or Cancel", False
            theToolEvents.ToolChangePrompt Me, LoadResString(102), False
        End If
    End If

    Exit Function
ErrorHandler:
'    MsgBox Err.Msg
    Call Finish
End Function

'Fill arrays with information about tools in the package
'Return the number of tools in the package
Public Function GetToolInfo(CommandNames As Variant, MenuCaptions As Variant, StatusPrompts As Variant, _
    ToolTips As Variant, Enabled As Variant, WantsUpdates As Variant) As Long

    ReDim CommandNames(NUM_TOOLS, 4)
    ReDim MenuCaptions(NUM_TOOLS, 2)
    ReDim StatusPrompts(NUM_TOOLS, 2)
    ReDim ToolTips(NUM_TOOLS)
    ReDim Enabled(NUM_TOOLS)
    ReDim WantsUpdates(NUM_TOOLS)
    CommandNames(0, 0) = LoadResString(103)   '"Modify|Join Polyline"
    CommandNames(0, 1) = "Generic Properties"
    CommandNames(0, 2) = "Polyline"
    CommandNames(0, 3) = "Internal"

    MenuCaptions(0, 0) = LoadResString(104)     '"&Join Polyline"
    MenuCaptions(0, 1) = LoadResString(104)     '"&Join Polyline"
    StatusPrompts(0, 0) = LoadResString(105)    '"Join Polyline"
    StatusPrompts(0, 1) = "95138"
    ToolTips(0) = LoadResString(105)    '"Join Polyline"
    Enabled(0) = True
    WantsUpdates(0) = False
    GetToolInfo = NUM_TOOLS
End Function

'Returns true if tool is correctly initialized
Public Function Initialize(ByVal Tool As Object) As Boolean
On Error GoTo ErrorHandler
    Set objApp = Tool.Application
    Set theToolEvents = objApp
    ARCTYPE = LoadResString(122)
    GRAPHICTYPE = LoadResString(123)

    iConnectId = -1
    iActTool = -1
    Initialize = True
    Exit Function
ErrorHandler:
 '   MsgBox Err.Description
End Function

'Returns true if tool is correctly initialized
Public Function UpdateToolStatus(ByVal Tool As Object, Enabled As Boolean, Checked As Boolean) As Boolean
    Enabled = True 'Could do a test here to determine whether to disable the button/menu item
    If iConnectId = -1 Then
        Checked = False  'Could do a test here to determine whether to check the button/menu item
    Else
        Checked = True
    End If
    UpdateToolStatus = True
End Function

Public Function RunTool(WhichTool As Tool)
    On Error Resume Next
    Call SetOldColors
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function

Public Function BeforeExit(WhichApplication As Application, Cancel As Boolean)
    Call SetOldColors
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    Call Finish
End Function
Public Function DrawingNew(WhichDrawing As Drawing)
    On Error Resume Next
    Call SetOldColors
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function
Public Function DrawingOpen(WhichDrawing As Drawing)
    On Error Resume Next
    Call SetOldColors
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Call Finish
End Function
Public Function DrawingActivate(WhichDrawing As Drawing)
    On Error Resume Next
    Call SetOldColors
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Call Finish
End Function
Public Function DrawingDeactivate(WhichDrawing As Drawing)
    On Error Resume Next
    Call SetOldColors
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Call Finish
End Function
Public Function DrawingBeforeClose(WhichDrawing As Drawing, Cancel As Boolean)
    On Error Resume Next
    Call SetOldColors
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Call Finish
End Function
Public Function DrawingBeforeSave(WhichDrawing As Drawing, SaveAs As Boolean, Cancel As Boolean)
    On Error Resume Next
    Call SetOldColors
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Call Finish
End Function

Public Function MouseDown(WhichDrawing As Drawing, WhichView As View, WhichWindow As Window, Button As ImsiMouseButton, Shift As Long, x As Long, y As Long, Cancel As Boolean)
Dim xClick#, yClick#
On Error GoTo ErrorHandler
'    Set Drs = objApp.Drawings
'    Set actDr = WhichDrawing
'    Set Grs = actDr.Graphics
'    Set Vis = actDr.Views
    Set Vi = WhichView
'    hDr = TCWDrawingActive
'    DifferentWorkPlane = False
'    Grs.Unselect
'    Vi.Refresh

   Vi.ScreenToView x, y, xClick, yClick

    If Button = imsiLeftButton Then
'MsgBox (CStr(Checked(1)))
        Cancel = True
        If SelectedObjects = True Then
'            MsgBox "There are some selected objects. Use items ""Finish"" or ""Cancel"" in LocalMenu", , "JointPolyline"
            MsgBox LoadResString(106), , LoadResString(105)
            Exit Function
        End If
        If Checked(1) = False Then
            If NumSetID = 0 Then
                Set Drs = objApp.Drawings
                Set actDr = WhichDrawing
                Set Grs = actDr.Graphics
                Set Vis = actDr.Views
                Set Vi = WhichView
                hDr = TCWDrawingActive
                DifferentWorkPlane = False
                Set GrSets = actDr.GraphicSets
                Set GrSet = GrSets.Add
                OneStepBack = False
            End If
Dim AppInt%
Dim Apper#
Dim xVi0#, xW0#, xVi1#, xW1#
            AppInt = objApp.Properties("Aperture")
            If AppInt < 3 Then AppInt = 3
            Vi.ScreenToView 0, 0, xVi0, 0
            Vi.ViewToWorld xVi0, 0, 0, xW0, 0, 0
            Vi.ScreenToView AppInt, 0, xVi1, 0
            Vi.ViewToWorld xVi1, 0, 0, xW1, 0, 0
            Apper = Abs(xVi1 - xVi0)

Dim PickRes As PickResult
            Set PickRes = Vi.PickPoint(xClick, yClick, Apper)
Dim PickCount As Long, i As Long, j As Long, GrType$
Dim GrID As Long
Dim Exist As Boolean
Dim NumSetIDOld As Long
            NumSetIDOld = NumSetID
            PickCount = PickRes.Count
            For i = 0 To PickCount - 1
                Set Gr = PickRes(i).Graphic
                GrType = Gr.Type
                If GrType <> ARCTYPE And GrType <> GRAPHICTYPE And GrType <> "TCW50Polyline" And GrType <> "TCW30CURVE" Then
                    Beep
'                    MsgBox "Clicked Graphic can't take part in operation", , "JointPolyline"
                    MsgBox LoadResString(107), , LoadResString(105)
                    GoTo LL
                End If
                If Gr.Unbounded = True Then
                    Beep
'                    MsgBox "Clicked Graphic can't take part in operation", , "JointPolyline"
                    MsgBox LoadResString(107), , LoadResString(105)
                    GoTo LL
                End If
                If GrType = "TCW50Polyline" Then
                    If Gr.Graphics(0).Properties("Info") = "Line_Width_Cosmetic" Then
                        Beep
'                        MsgBox "Clicked Graphic - Polyline with Width can't take part in operation", , "JointPolyline"
                        MsgBox LoadResString(108), , LoadResString(105)
                        GoTo LL
                    End If
                End If
                If actDr.Properties("TileMode") = 1 Then
Dim Thick#
                    Thick = -1000000#
                    On Error Resume Next
                    Thick = Gr.Properties("Thickness")
                    If Thick = -1000000 Then ' For 3D-Polyline
                        Beep
'                       MsgBox "Clicked Graphic can't take part in operation", , "JointPolyline"
                        MsgBox LoadResString(107), , LoadResString(105)
                        GoTo LL
                    End If
                    If Gr.Properties("Thickness") <> 0 Then
                        Beep
'                        MsgBox "Clicked Graphic has thickness - can't take part in operation", , "JointPolyline"
                        MsgBox LoadResString(109), , LoadResString(105)
                        GoTo LL
                    End If
                End If
                If GrType <> ARCTYPE And Gr.Closed = True Then
                    Beep
'                    MsgBox "Clicked Graphic is closed.", , "JointPolyline"
                    MsgBox LoadResString(110), , LoadResString(105)
                    GoTo LL
                End If
                GrID = Gr.ID
                Exist = False
                For j = 0 To NumSetID - 1
                    If SetID(j) = GrID Then Exist = True
                Next j
                If Exist = False Then
                    GrSet.AddGraphic Gr
                    SetID(NumSetID) = GrID
'MsgBox (CStr(SetID(NumSetID)))
                    OldSetColor(NumSetID) = Gr.Properties("PenColor")
                    Gr.Properties("PenColor") = QBColor(13)
                    Gr.Draw
                    NumSetID = NumSetID + 1
                End If
LL:
            Next i
            If NumSetIDOld = NumSetID Then Beep
            If NumSetID > 0 Then
                EnableSequence = False
                OneStepBack = True
                FinishJoint = True
                AddLM False
                AddLM True
            End If

'            theToolEvents.ToolChangePrompt Me, "", False
'            If iConnectId <> -1 Then
'                objApp.DisconnectEvents iConnectId
'                iConnectId = -1
'                AddLM False
'            End If
            Exit Function
        Else
            Set Drs = objApp.Drawings
            Set actDr = WhichDrawing
            Set Grs = actDr.Graphics
            Set Vis = actDr.Views
            Set Vi = WhichView
            hDr = TCWDrawingActive
            DifferentWorkPlane = False
'            theToolEvents.ToolChangePrompt Me, "Pick any segment", False
            theToolEvents.ToolChangePrompt Me, LoadResString(101), False
            theToolEvents.ToolChangePrompt Me, "", False
            CoincidentGroup xClick, yClick
            If iConnectId <> -1 Then
                objApp.DisconnectEvents iConnectId
                iConnectId = -1
                AddLM False
            End If
        End If
    Else

        Cancel = False
    End If
'    Call Finish

    Exit Function
ErrorHandler:
    Call SetOldColors
   If iConnectId <> -1 Then
        theToolEvents.ToolChangePrompt Me, "", False
        objApp.DisconnectEvents iConnectId
        iConnectId = -1
        AddLM False
    End If
    Call Finish

 '   MsgBox Err.Description
End Function

Public Function Cancel(DoItPlease As Boolean, CanCancel As Boolean)
    If (DoItPlease) Then
        If iConnectId <> -1 Then
            theToolEvents.ToolChangePrompt Me, "", False
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
        End If
        Call Finish
        theToolEvents.ToolChangePrompt Me, "", False
    End If

    CanCancel = True
End Function

Public Function UpdateUndo(AllowsUndo As Boolean)
    AllowsUndo = False
End Function

Private Function AddActToolLM(iTool As Long, bAdd As Boolean)
'    AddLM bAdd
End Function
Private Sub Class_Terminate()
    If (Not theToolEvents Is Nothing) Then
        Set theToolEvents = Nothing
    End If
    If (Not objApp Is Nothing) Then
        Set objApp = Nothing
    End If

End Sub

Private Function AddLM(bAdd As Boolean)
'Dim Captions(0 To 1) As String
'Dim Prompts(0 To 1) As String
'Dim Enabled(0 To 1) As Boolean
'Dim Checked(0 To 1) As Boolean

Dim varCaptions As Variant
Dim varPrompts As Variant
Dim varEnabled As Variant
Dim varChecked As Variant

    If (bAdd) Then
        Captions(0) = LoadResString(111)    '"Delete Original Objects"
        Prompts(0, 0) = LoadResString(111)  '"Delete Original Objects"
        Prompts(0, 1) = "95138"
        Enabled(0) = True
        Checked(0) = DeleteObjects

        Captions(1) = LoadResString(112)    '"Auto joining"
        Prompts(1, 0) = LoadResString(113)  '"Join By Sequence or Auto"
        Prompts(1, 1) = "95138"
        Enabled(1) = EnableSequence
        Checked(1) = False

        Captions(2) = LoadResString(114)    '"One Step Back"
        Prompts(2, 0) = LoadResString(115)  '"One Step Back for selection by sequence"
        Prompts(2, 1) = "95138"
        Enabled(2) = OneStepBack
        Checked(2) = False

        Captions(3) = LoadResString(116)    '"Finish Join Polyline"
        Prompts(3, 0) = LoadResString(116)  '"Finish Join Polyline"
        Prompts(3, 1) = "95138"
        Enabled(3) = FinishJoint
        Checked(3) = False

        Captions(4) = LoadResString(117)    '"Cancel"
        Prompts(4, 0) = LoadResString(118)  '"Cancel JoinPolyline"
        Prompts(4, 1) = "95138"
        Enabled(4) = True
        Checked(4) = False

        varCaptions = Captions
        varPrompts = Prompts
        varEnabled = Enabled
        varChecked = Checked

        theToolEvents.ToolChangeCommands Me, 5, varCaptions, varPrompts, varEnabled, varChecked, True
'        theToolEvents.ToolChangeCommands Me, 1, varCaptions, varPrompts, varEnabled, varChecked, True

    Else
        theToolEvents.ToolChangeCommands Me, 0, , , , , False
    End If
End Function

Public Function DoLMCommand(CmdInd As Long)
'MsgBox ("CmdInd=" & CStr(CmdInd))
    'Finish JoinPolyline
    If CmdInd = 3 Then
        ' if objects were selected by sequence
        If actDr.Selection.Count = 0 And Checked(1) = False Then
Dim i As Long
                For i = 0 To NumSetID - 1
                    Set Gr = Grs.GraphicFromID(SetID(i))
                    Gr.Properties("PenColor") = OldSetColor(i)
                Next i
                If NumSetID > 0 Then
                    Call SelectionToGroup(GrSet)
                End If
                TCWViewRedraw
                GrSet.Clear
        End If
        ' if Objects were selected by Selector
        If actDr.Selection.Count > 1 Or SelectedObjects = True Then
'MsgBox (CStr(GrSet.Count))
            actDr.Graphics.Unselect
            NumSetID = 1
            OldSetColor(0) = GrSet(0).Properties("PenColor")
            Call SelectionToGroup(GrSet)
            TCWViewRedraw
            GrSet.Clear
        End If
'        GrSet.Delete
        If iConnectId <> -1 Then
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
            AddLM False
        End If
        theToolEvents.ToolChangePrompt Me, "", False

        Call Finish
'        Set objApp = Nothing
        Exit Function
    End If
Dim varCaptions As Variant
Dim varPrompts As Variant
Dim varEnabled As Variant
Dim varChecked As Variant
    'Delete Original Objects
    If CmdInd = 0 Then
        If Checked(0) = True Then
            DeleteObjects = False
            Checked(0) = False
        Else
            DeleteObjects = True
            Checked(0) = True
        End If
        varCaptions = Captions
        varPrompts = Prompts
        varEnabled = Enabled
        varChecked = Checked
        theToolEvents.ToolChangeCommands Me, 5, varCaptions, varPrompts, varEnabled, varChecked, True
   End If
   ' Auto Joining
   If CmdInd = 1 Then
        If Checked(1) = True Then
            Checked(1) = False
        Else
            Checked(1) = True
        End If
        varCaptions = Captions
        varPrompts = Prompts
        varEnabled = Enabled
        varChecked = Checked
        theToolEvents.ToolChangeCommands Me, 5, varCaptions, varPrompts, varEnabled, varChecked, True
   End If
   ' Cancel Joint Polyline
   If CmdInd = 4 Then
        For i = 0 To NumSetID - 1
'MsgBox (CStr(SetID(i)))
            Set Gr = Grs.GraphicFromID(SetID(i))
            Gr.Properties("PenColor") = OldSetColor(i)
            If GrSets Is Nothing Then
            Else
                GrSet.Clear
                GrSet.Delete
            End If
        Next i
        If iConnectId <> -1 Then
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
            AddLM False
        End If
        theToolEvents.ToolChangePrompt Me, "", False
        Call Finish
        TCWViewRedraw
   End If
   ' One Step Back
   If CmdInd = 2 Then
Dim GrSetCount As Long
        GrSetCount = GrSet.Count
        If GrSetCount > 0 Then
            Set Gr = GrSet(GrSetCount - 1)
            Gr.Properties("PenColor") = OldSetColor(NumSetID - 1)
            Gr.Draw
            GrSet.Remove GrSetCount - 1
            NumSetID = NumSetID - 1
        End If
        If NumSetID = 0 Then
            Enabled(1) = True
            Enabled(2) = False
            Enabled(3) = False
            varCaptions = Captions
            varPrompts = Prompts
            varEnabled = Enabled
            varChecked = Checked
            theToolEvents.ToolChangeCommands Me, 5, varCaptions, varPrompts, varEnabled, varChecked, True
        End If
   End If
End Function

' Select the coicident Graphics and write its into Group

Private Function CoincidentGroup(xCl As Double, yCl As Double) As Boolean
Dim Gr As Graphic
Dim Gr1 As Graphic
Dim Gr2 As Graphic
Dim Gr3 As Graphic
Dim Gr4 As Graphic
Dim GrGroup As Graphic
Dim PicRes As PickResult
Dim Vers As Vertices
Dim UnDirection As Boolean 'Revers from begining point
    UnDirection = False
    NumSetID = 0
Dim GrGroupID As Long
Dim xClW#, yClW#, zClW#
    Vi.ViewToWorld xCl, yCl, 0, xClW, yClW, zClW
Dim dir As Long
    dir = 1
LBEG0:
Dim GrFirstID As Long, GrLastID As Long '!!!!!!!!!!!!!!!!!!!!!!!
    Set GrGroup = Grs.Add(11)
    If actDr.Properties("TileMode") = 1 Then
        GrGroup.Properties("Thickness") = 0
    End If
    GrGroupID = GrGroup.ID
Dim ViWidth#, Aper#
    ViWidth = Vi.ViewWidth
    Aper = ViWidth / 50
    actDr.Application.SnapModes = 1
    Set PicRes = Vi.PickPoint(xCl, yCl, Aper, True, True, True, True, True, True)
    If PicRes.Count = 0 Then
        Beep
'        MsgBox "There is no clicked object", , "JointPolyline"
        MsgBox LoadResString(119), , LoadResString(105)
        GrGroup.Deleted = True
        Set Vers = Nothing
        Set Gr = Nothing
        Set Gr1 = Nothing
        Set Gr2 = Nothing
        Set Gr3 = Nothing
        Set Gr4 = Nothing
        Set GrGroup = Nothing
        Set PicRes = Nothing
        Call Finish
        CoincidentGroup = False
        Exit Function
    End If
    Set Gr = PicRes(0).Graphic

Dim nV As Long, i As Long, j As Long
Dim iEnd As Long
Dim IndexRight As Long
    IndexRight = -1
Dim xV0#, yV0#, zV0#, xV1#, yV1#, zV1#
Dim xBeg#, yBeg#, zBeg#, xEnd#, yEnd#, zEnd#
Dim xBeg0#, yBeg0#, zBeg0#
Dim a#, b#, c#
Dim L#, lMin#, iMin As Long
    iMin = 0
    lMin = 1000000#
    GrLastID = Gr.ID
    GrFirstID = Gr.ID
' Find first segment of contour
Dim GrType$
    GrType = Gr.Type
    If GrType <> ARCTYPE And GrType <> GRAPHICTYPE And GrType <> "TCW50Polyline" And GrType <> "TCW30CURVE" Then
        Beep
'        MsgBox "Clicked Graphic can't take part in operation", , "JointPolyline"
        MsgBox LoadResString(107), , LoadResString(105)
        GrGroup.Deleted = True
        Set Vers = Nothing
        Set Gr = Nothing
        Set Gr1 = Nothing
        Set Gr2 = Nothing
        Set Gr3 = Nothing
        Set Gr4 = Nothing
        Set GrGroup = Nothing
        Set PicRes = Nothing
        Call Finish
        CoincidentGroup = False
        Exit Function
    End If

    SetID(NumSetID) = Gr.ID '??????????

' *******************************************************************
    PenColor = Gr.Properties("PenColor")
    PenWidth = Gr.Properties("PenWidth")
    PenStyle = Gr.Properties("PenStyle")
' *******************************************************************
Dim hGr As Long, hMat As Long
    hGr = TCWGraphicAt(hDr, Gr.Index)
    hMatFirst = GraphicGetMatrix(hGr)
Dim Res1 As Boolean
    hGr = TCWGraphicAt(hDr, GrGroup.Index)
'    Res1 = GraphicSetMatrix(hGr, hMatFirst) ' !!!!!
    If GrType <> ARCTYPE And Gr.Closed = True Then
        Beep
'        MsgBox "Clicked Graphic is closed.", , "JointPolyline"
        MsgBox LoadResString(110), , LoadResString(105)
        GrGroup.Deleted = True
        Set Vers = Nothing
        Set Gr = Nothing
        Set Gr1 = Nothing
        Set Gr2 = Nothing
        Set Gr3 = Nothing
        Set Gr4 = Nothing
        Set GrGroup = Nothing
        Set PicRes = Nothing
        Call Finish
        CoincidentGroup = False
        Exit Function
    End If

    If GrType = GRAPHICTYPE Then
        Set Vers = Gr.Vertices
        Vers.UseWorldCS = True
        nV = Vers.Count
        If Gr.Unbounded = True Then
            Beep
'            MsgBox "Clicked Graphic can't take part in operation", , "JointPolyline"
            MsgBox LoadResString(107), , LoadResString(105)
            GrGroup.Deleted = True
            Set Vers = Nothing
            Set Gr = Nothing
            Set Gr1 = Nothing
            Set Gr2 = Nothing
            Set Gr3 = Nothing
            Set Gr4 = Nothing
            Set GrGroup = Nothing
            Set PicRes = Nothing
            Call Finish
            CoincidentGroup = False
            Exit Function
        End If
        If Gr.Graphics.Count > 0 Then
            Beep
'            MsgBox "Clicked Graphic is a group.Explode it and try again.", , "JointPolyline"
            MsgBox LoadResString(120), , LoadResString(105)
            GrGroup.Deleted = True
            Set Vers = Nothing
            Set Gr = Nothing
            Set Gr1 = Nothing
            Set Gr2 = Nothing
            Set Gr3 = Nothing
            Set Gr4 = Nothing
            Set GrGroup = Nothing
            Set PicRes = Nothing
            Call Finish
            CoincidentGroup = False
            Exit Function
        End If
        If Gr.Closed = True Then
            Beep
'            MsgBox "Clicked Graphic is closed.", , "JointPolyline"
            MsgBox LoadResString(110), , LoadResString(105)
            GrGroup.Deleted = True
            Set Vers = Nothing
            Set Gr = Nothing
            Set Gr1 = Nothing
            Set Gr2 = Nothing
            Set Gr3 = Nothing
            Set Gr4 = Nothing
            Set GrGroup = Nothing
            Set PicRes = Nothing
            Call Finish
            CoincidentGroup = False
            Exit Function
        End If
        For i = 1 To nV - 1
            If Vers(i).PenDown = False Then
                Beep
'                MsgBox "Clicked Graphic can't take part in operation", , "JointPolyline"
                MsgBox LoadResString(107), , LoadResString(105)
                GrGroup.Deleted = True
                Set Vers = Nothing
                Set Gr = Nothing
                Set Gr1 = Nothing
                Set Gr2 = Nothing
                Set Gr3 = Nothing
                Set Gr4 = Nothing
                Set GrGroup = Nothing
                Set PicRes = Nothing
                Call Finish
                CoincidentGroup = False
                Exit Function
            End If
        Next i
        xBeg0 = Vers(0).x
        yBeg0 = Vers(0).y
        zBeg0 = Vers(0).Z
        xBeg = Vers(0).x
        yBeg = Vers(0).y
        zBeg = Vers(0).Z
        xEnd = Vers(nV - 1).x
        yEnd = Vers(nV - 1).y
        zEnd = Vers(nV - 1).Z
'        iEnd = iMin + 1
        dir = 1
        Set Gr1 = Gr.Duplicate
        Gr1.Properties("PenColor") = RGB(0, 255, 0)
        Set Gr1 = Grs.Remove(Gr1.Index)
        GrGroup.Graphics.AddGraphic Gr1

'        Vi.Refresh
'MsgBox ("!!!!")
    End If
    If GrType = ARCTYPE Then
        If Gr.Graphics.Count > 0 Then
            Beep
'            MsgBox "Clicked Graphic is a group.Explode it and try again.", , "JointPolyline"
            MsgBox LoadResString(120), , LoadResString(105)
            GrGroup.Deleted = True
            Set Vers = Nothing
            Set Gr = Nothing
            Set Gr1 = Nothing
            Set Gr2 = Nothing
            Set Gr3 = Nothing
            Set Gr4 = Nothing
            Set GrGroup = Nothing
            Set PicRes = Nothing
            Call Finish
            CoincidentGroup = False
            Exit Function
        End If
        Set Vers = Gr.Vertices
        Vers.UseWorldCS = True
        xBeg0 = Vers(1).x
        yBeg0 = Vers(1).y
        zBeg0 = Vers(1).Z
        xBeg = Vers(1).x
        yBeg = Vers(1).y
        zBeg = Vers(1).Z
        xEnd = Vers(2).x
        yEnd = Vers(2).y
        zEnd = Vers(2).Z
        iEnd = 2
        Set Gr1 = Gr.Duplicate
        Gr1.Properties("PenColor") = RGB(0, 255, 0)
        Set Gr1 = Grs.Remove(Gr1.Index)
        GrGroup.Graphics.AddGraphic Gr1
'        Vi.Refresh
'MsgBox ("!!!!")
    End If

    If GrType = "TCW50Polyline" Or GrType = "TCW30CURVE" Then
        If GrType = "TCW50Polyline" Then
            If Gr.Graphics(0).Properties("Info") = "Line_Width_Cosmetic" Then
                Beep
'                MsgBox "Clicked Graphic - Polyline with Width can't take part in operation", , "JointPolyline"
                MsgBox LoadResString(108), , LoadResString(105)
                GrGroup.Deleted = True
                Set Vers = Nothing
                Set Gr = Nothing
                Set Gr1 = Nothing
                Set Gr2 = Nothing
                Set Gr3 = Nothing
                Set Gr4 = Nothing
                Set GrGroup = Nothing
                Set PicRes = Nothing
                Call Finish
                CoincidentGroup = False
                Exit Function
            End If
        End If
        Set Vers = Gr.Vertices
        Vers.UseWorldCS = True
        xBeg0 = Vers(0).x
        yBeg0 = Vers(0).y
        zBeg0 = Vers(0).Z
        xBeg = Vers(0).x
        yBeg = Vers(0).y
        zBeg = Vers(0).Z
        Set Vers = Gr.Vertices
        nV = Vers.Count
        xEnd = Vers(nV - 1).x
        yEnd = Vers(nV - 1).y
        zEnd = Vers(nV - 1).Z
        iEnd = nV - 1
        Set Gr1 = Gr.Duplicate
        Gr1.Properties("PenColor") = RGB(0, 255, 0)
        Set Gr1 = Grs.Remove(Gr1.Index)
        GrGroup.Graphics.AddGraphic Gr1
'        Vi.Refresh
'MsgBox ("!!!!")
    End If

'TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
'TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT
'TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTT

' Find next segment
Dim xView#, yView#, zView#
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Dim GrSets As GraphicSets   '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Dim GrSet As GraphicSet     '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    Set GrSets = actDr.GraphicSets '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    Set GrSet = GrSets.Add  '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    GrSet.Clear
    GrSet.AddGraphic Gr
    OldSetColor(0) = Gr.Properties("PenColor")

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
LBEG:
    Vi.WorldToView xEnd, yEnd, zEnd, xView, yView, zView
    Set PicRes = Vi.PickPoint(xView, yView, 0.001, True, True, True, True, True, False)

'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Dim Gr4Type As String '!!!!!!!!!!!!!!!!!!!!!!!!!
Dim GrSetCount As Long, GrSetID As Long
    GrSetCount = 0
    For i = 0 To PicRes.Count - 1 '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        Set Gr4 = PicRes(i).Graphic '!!!!!!!!!!!!!!!!!!!!!!!!!
        If Gr4.ID = GrLastID Then GoTo PPP
        hGr = TCWGraphicAt(hDr, Gr4.Index)
        hMat = GraphicGetMatrix(hGr)
        If MatrixEqual(hMatFirst, hMat) = False Then GoTo PPP
        Gr4Type = Gr4.Type '!!!!!!!!!!!!!!!!!!!!!!!!!
        If Gr4.Type <> ARCTYPE And Gr4.Closed = True Then GoTo PPP
        If Gr4Type = ARCTYPE Or Gr4Type = GRAPHICTYPE Or Gr4Type = "TCW50Polyline" Or Gr4Type = "TCW30CURVE" Then '!!!!!!!!!!!!!!!!!!!!!!!!!
            Gr4.Vertices.UseWorldCS = True '!!!!!!!!!!!!!!!!!!!!!!!!!
            Set Vers = Gr4.Vertices '!!!!!!!!!!!!!!!!!!!!!!!!!
            If Gr4Type = ARCTYPE And Gr4.Graphics.Count = 0 Then '!!!!!!!!!!!!!!!!!!!!!!!!!
                xV0 = Vers(1).x '!!!!!!!!!!!!!!!!!!!!!!!!!
                yV0 = Vers(1).y '!!!!!!!!!!!!!!!!!!!!!!!!!
                zV0 = Vers(1).Z '!!!!!!!!!!!!!!!!!!!!!!!!!

                xV1 = Vers(2).x '!!!!!!!!!!!!!!!!!!!!!!!!!
                yV1 = Vers(2).y '!!!!!!!!!!!!!!!!!!!!!!!!!
                zV1 = Vers(2).Z '!!!!!!!!!!!!!!!!!!!!!!!!!
                If Abs(xEnd - xV0) < Eps And Abs(yEnd - yV0) < Eps And Abs(zEnd - zV0) < Eps Then 'GrSet.AddGraphic Gr4    '!!!!!!!!!!!!!!!!!!!!!!!!!
                    GrSetCount = GrSetCount + 1
                    GrSetID = Gr4.ID
                End If
                If Abs(xEnd - xV1) < Eps And Abs(yEnd - yV1) < Eps And Abs(zEnd - zV1) < Eps Then 'GrSet.AddGraphic Gr4    '!!!!!!!!!!!!!!!!!!!!!!!!!
                    GrSetCount = GrSetCount + 1
                     GrSetID = Gr4.ID
                End If
            End If  '!!!!!!!!!!!!!!!!!!!!!!!!!
            If Gr4Type = "TCW50Polyline" Or Gr4Type = "TCW30CURVE" Then '!!!!!!!!!!!!!!!!!!!!!!!!!
                If GrType = "TCW50Polyline" Then
                    If Gr.Graphics(0).Properties("Info") = "Line_Width_Cosmetic" Then
                        GoTo PPP
                    End If
                End If
                xV0 = Vers(0).x '!!!!!!!!!!!!!!!!!!!!!!!!!
                yV0 = Vers(0).y '!!!!!!!!!!!!!!!!!!!!!!!!!
                zV0 = Vers(0).Z '!!!!!!!!!!!!!!!!!!!!!!!!!

                xV1 = Vers(Vers.Count - 1).x '!!!!!!!!!!!!!!!!!!!!!!!!!
                yV1 = Vers(Vers.Count - 1).y '!!!!!!!!!!!!!!!!!!!!!!!!!
                zV1 = Vers(Vers.Count - 1).Z '!!!!!!!!!!!!!!!!!!!!!!!!!
                If Abs(xEnd - xV0) < Eps And Abs(yEnd - yV0) < Eps And Abs(zEnd - zV0) < Eps Then 'GrSet.AddGraphic Gr4  '!!!!!!!!!!!!!!!!!!!!!!!!!
                    GrSetCount = GrSetCount + 1
                    GrSetID = Gr4.ID
                End If
                If Abs(xEnd - xV1) < Eps And Abs(yEnd - yV1) < Eps And Abs(zEnd - zV1) < Eps Then 'GrSet.AddGraphic Gr4 '!!!!!!!!!!!!!!!!!!!!!!!!!
                    GrSetCount = GrSetCount + 1
                    GrSetID = Gr4.ID
                End If
            End If  '!!!!!!!!!!!!!!!!!!!!!!!!!
            If Gr4Type = GRAPHICTYPE And Gr4.Graphics.Count = 0 And Gr4.Closed = False Then    '!!!!!!!!!!!!!!!!!!!!!!!!!
Dim PenDownFalse As Boolean
                PenDownFalse = True
                For j = 1 To Vers.Count - 1 '!!!!!!!!!!!!!!!!!!!!!!!!!
                    If Vers(j).PenDown = False Then
                        PenDownFalse = False
                        Exit For
                    End If
                Next j
                If PenDownFalse = True Then
                    xV0 = Vers(0).x     '!!!!!!!!!!!!!!!!!!!!!!!!!
                    yV0 = Vers(0).y     '!!!!!!!!!!!!!!!!!!!!!!!!!
                    zV0 = Vers(0).Z     '!!!!!!!!!!!!!!!!!!!!!!!!!

                    xV1 = Vers(Vers.Count - 1).x     '!!!!!!!!!!!!!!!!!!!!!!!!!
                    yV1 = Vers(Vers.Count - 1).y     '!!!!!!!!!!!!!!!!!!!!!!!!!
                    zV1 = Vers(Vers.Count - 1).Z     '!!!!!!!!!!!!!!!!!!!!!!!!!
                    If Abs(xEnd - xV0) < Eps And Abs(yEnd - yV0) < Eps And Abs(zEnd - zV0) < Eps Then  '!!!!!!!!!!!!!!!!!!!!!!!!!
'                        GrSet.AddGraphic Gr4    '!!!!!!!!!!!!!!!!!!!!!!!!!
                        GrSetCount = GrSetCount + 1
                         GrSetID = Gr4.ID
                    End If  '!!!!!!!!!!!!!!!!!!!!!!!!!
                    If Abs(xEnd - xV1) < Eps And Abs(yEnd - yV1) < Eps And Abs(zEnd - zV1) < Eps Then  '!!!!!!!!!!!!!!!!!!!!!!!!!
'                        GrSet.AddGraphic Gr4    '!!!!!!!!!!!!!!!!!!!!!!!!!
                        GrSetCount = GrSetCount + 1
                        GrSetID = Gr4.ID
                    End If  '!!!!!!!!!!!!!!!!!!!!!!!!!
                End If '!!!!!!!!!!!!!!!!!!!!!!!!!
            End If  '!!!!!!!!!!!!!!!!!!!!!!!!!
        End If  '!!!!!!!!!!!!!!!!!!!!!!!!!
PPP:
    Next i '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    If GrSetCount > 1 Then '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Dim nV1 As Long
        If UnDirection = True Then
            GoTo LEnd
        Else
            UnDirection = True
            xV0 = xEnd
            yV0 = yEnd
            zV0 = zEnd
            xEnd = xBeg0
            yEnd = yBeg0
            zEnd = zBeg0
            xBeg0 = xV0
            yBeg0 = yV0
            zBeg0 = zV0
            GrLastID = GrFirstID
            Call GroupToGroup(GrGroup)
            GoTo LBEG
        End If
    End If

'#############################################################
'#############################################################
    If GrSetCount = 0 Then '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        If UnDirection = True Then
            GoTo LEnd
        Else
            UnDirection = True
            xV0 = xEnd
            yV0 = yEnd
            zV0 = zEnd
            xEnd = xBeg0
            yEnd = yBeg0
            zEnd = zBeg0
            xBeg0 = xV0
            yBeg0 = yV0
            zBeg0 = zV0
            GrLastID = GrFirstID
            Call GroupToGroup(GrGroup)
            GoTo LBEG
        End If
    End If ' If PicRes.Count=2

'###################################################################
'###################################################################
    If GrSetCount = 1 Then '!!!!!!!!!!!!!
        Set Gr2 = Grs.GraphicFromID(GrSetID)  '!!!!!!!!!!!!!
        GrLastID = Gr2.ID
        hGr = TCWGraphicAt(hDr, Gr2.Index)

        NumSetID = NumSetID + 1     '????????????????????
        SetID(NumSetID) = Gr2.ID    '????????????????????
        GrSet.AddGraphic Gr2
        If Gr2.Type = ARCTYPE Then
            Gr2.Vertices.UseWorldCS = True
            xV0 = Gr2.Vertices(1).x
            yV0 = Gr2.Vertices(1).y
            zV0 = Gr2.Vertices(1).Z
            xV1 = Gr2.Vertices(2).x
            yV1 = Gr2.Vertices(2).y
            zV1 = Gr2.Vertices(2).Z
            If Abs(xV0 - xEnd) < Eps And Abs(yV0 - yEnd) < Eps And Abs(zV0 - zEnd) < Eps Then
                iEnd = 2
                xBeg = xV0
                yBeg = yV0
                zBeg = zV0
                xEnd = xV1
                yEnd = yV1
                zEnd = zV1
            Else
                iEnd = 1
                xBeg = xV1
                yBeg = yV1
                zBeg = zV1
                xEnd = xV0
                yEnd = yV0
                zEnd = zV0
            End If
            Set Gr1 = Gr2.Duplicate
            Gr1.Properties("PenColor") = RGB(0, 255, 0)
            Set Gr1 = Grs.Remove(Gr1.Index)
            GrGroup.Graphics.AddGraphic Gr1
'           Vi.Refresh
'MsgBox ("!!!!")
        End If

        If Gr2.Type = GRAPHICTYPE Or Gr2.Type = "TCW50Polyline" Or Gr2.Type = "TCW30CURVE" Then
            Gr2.Vertices.UseWorldCS = True
            nV = Gr2.Vertices.Count
            xV0 = Gr2.Vertices(0).x
            yV0 = Gr2.Vertices(0).y
            zV0 = Gr2.Vertices(0).Z
            xV1 = Gr2.Vertices(nV - 1).x
            yV1 = Gr2.Vertices(nV - 1).y
            zV1 = Gr2.Vertices(nV - 1).Z
            If Abs(xV0 - xEnd) < Eps And Abs(yV0 - yEnd) < Eps And Abs(zV0 - zEnd) < Eps Then
                iEnd = nV - 1
                xBeg = xV0
                yBeg = yV0
                zBeg = zV0
                xEnd = xV1
                yEnd = yV1
                zEnd = zV1
            Else
                iEnd = 0
                xBeg = xV1
                yBeg = yV1
                zBeg = zV1
                xEnd = xV0
                yEnd = yV0
                zEnd = zV0
            End If
            Set Gr1 = Gr2.Duplicate
            Gr1.Properties("PenColor") = RGB(0, 255, 0)
            Set Gr1 = Grs.Remove(Gr1.Index)
            GrGroup.Graphics.AddGraphic Gr1
'MsgBox ("!!!!")
        End If

    End If  'If Pic.Count=1

    If Abs(xEnd - xBeg0) < Eps And Abs(yEnd - yBeg0) < Eps And Abs(zEnd - zBeg0) < Eps Then
        GoTo LEnd
    Else
        GoTo LBEG
    End If
LEnd:
Dim GrNum As Long
        GrNum = GrGroup.Graphics.Count

'   Vi.Refresh
'MsgBox ("GrNum=" & CStr(GrNum) & " GrSetCount=" & CStr(GrSet.Count))
    If GrSet.Count > 1 Then
'Dim Res As Integer
'        Res = WorkPlaneEquation(GrGroup, xBeg0, yBeg0, zBeg0)
'        If Res <> 0 Then
'            Call Polyline50(GrGroup, UnDirection, xBeg0, yBeg0)
'            If Res = 2 Then
'                GrRes.MoveRelative 0, 0, zBeg0
'                GrRes.RotateAbsolute xBeg0, yBeg0, zBeg0 + 1, xBeg0 + aa, yBeg0 + bb, zBeg0 + cc, xBeg0, yBeg0, zBeg0
'            End If
'            GrRes.Properties("PenColor") = QBColor(13)
'            GrRes.Update
'Dim Time0 As Variant
'            Time0 = Timer
'            Do While Timer < Time0 + 0.1
'                DoEvents
'            Loop
'            GrRes.Properties("PenColor") = PenColor
'            GrRes.Update
            Call SelectionToGroup(GrSet)
            GrGroup.Deleted = True
            CoincidentGroup = True
'        Else
'            Beep
'            GrGroup.Deleted = True
'            CoincidentGroup = False
'        End If
    Else
        Beep
        GrGroup.Deleted = True
        CoincidentGroup = False
    End If
    Vi.Refresh

    GrSet.Clear
    Set Vers = Nothing
    Set Gr = Nothing
    Set Gr1 = Nothing
    Set Gr2 = Nothing
    Set Gr3 = Nothing
    Set Gr4 = Nothing
    Set GrGroup = Nothing
    Set PicRes = Nothing
    Call Finish

End Function

Private Sub GroupToGroup(GrGroup As Graphic)
Dim GrCopy As Graphic
Dim Count As Long, i As Long
    Count = GrGroup.Graphics.Count
    Set GrCopy = GrGroup.Duplicate

    With GrGroup.Graphics
        For i = 0 To Count - 1
            .Item(0).Deleted = True
        Next i
    End With

Dim GrIndex As Long
Dim GrChild As Graphic
    With GrCopy.Graphics
        For i = Count - 1 To 0 Step -1
            Set GrChild = .Item(i)
'            GrIndex = GrChild.Index
'MsgBox ("Index=" & CStr(GrIndex))
            GrIndex = i
            .Remove GrIndex
            GrGroup.Graphics.AddGraphic GrChild
        Next i
    End With
    GrCopy.Deleted = True
     Set GrChild = Nothing
     Set GrCopy = Nothing
End Sub

Private Sub Finish()
    Set GrSet = Nothing
    Set GrSets = Nothing
    Set Gr = Nothing
    Set GrRes = Nothing
    Set Grs = Nothing
    Set PEnt = Nothing
    Set PRes = Nothing
    Set Vi = Nothing
    Set Vis = Nothing
    Set Sel = Nothing
    Set actDr = Nothing
    Set Drs = Nothing
 '   Set objApp = Nothing
End Sub
' put the GrGroup  from current workplane on plane X0Y

Private Function WorkPlaneEquation(GrSel As Graphic, xBeg#, yBeg#, zBeg#) As Integer
Dim ChildCount As Long, i As Long
On Error GoTo LLLL
Dim x0#, y0#, z0#, x1#, y1#, z1#, x2#, y2#, z2#, xi#, yi#, zi#, xi1#, yi1#, zi1#
Dim dd#, ff#
Dim Gr1 As Graphic
Dim nV As Long
    ChildCount = GrSel.Graphics.Count
    Set Gr1 = GrSel.Graphics(0)
    If Gr1.Type = GRAPHICTYPE Then
        x0 = xBeg
        y0 = yBeg
        z0 = zBeg
        With Gr1.Vertices
            .UseWorldCS = True
            xi = .Item(0).x
            yi = .Item(0).y
            zi = .Item(0).Z
            xi1 = .Item(1).x
            yi1 = .Item(1).y
            zi1 = .Item(1).Z
            If Abs(xi - x0) < Eps And Abs(yi - y0) < Eps And Abs(zi - z0) < Eps Then
                x1 = xi1
                y1 = yi1
                z1 = zi1
            Else
                x1 = xi
                y1 = yi
                z1 = zi
            End If
        End With
        Set Gr1 = GrSel.Graphics(1)
        If Gr1.Type = GRAPHICTYPE Then
            With Gr1.Vertices
                .UseWorldCS = True
                xi = .Item(0).x
                yi = .Item(0).y
                zi = .Item(0).Z
                xi1 = .Item(1).x
                yi1 = .Item(1).y
                zi1 = .Item(1).Z
                If Abs(xi - x1) < Eps And Abs(yi - y1) < Eps And Abs(zi - z1) < Eps Then
                    x2 = xi1
                    y2 = yi1
                    z2 = zi1
                Else
                    x2 = xi
                    y2 = yi
                    z2 = zi
                End If
            End With
            GoTo LL
        End If
        If Gr1.Type = ARCTYPE Then
            With Gr1.Vertices
                .UseWorldCS = True
                x2 = .Item(0).x
                y2 = .Item(0).y
                z2 = .Item(0).Z
            End With
            GoTo LL
        End If
        nV = Gr1.Vertices.Count
        If nV > 3 Then
            i = CLng(nV / 2)
        Else
            i = 1
        End If
        With Gr1.Vertices
            .UseWorldCS = True
            x2 = .Item(i).x
            y2 = .Item(i).y
            z2 = .Item(i).Z
        End With
        GoTo LL
    Else
        If Gr1.Type = ARCTYPE Then
            With Gr1.Vertices
                .UseWorldCS = True
                x0 = .Item(0).x
                y0 = .Item(0).y
                z0 = .Item(0).Z
                x1 = .Item(1).x
                y1 = .Item(1).y
                z1 = .Item(1).Z
                x2 = .Item(2).x
                y2 = .Item(2).y
                z2 = .Item(2).Z
            End With
            GoTo LL
        End If
        nV = Gr1.Vertices.Count
        If nV > 3 Then
            i = CLng(nV / 2)
        Else
            i = 1
        End If
        With Gr1.Vertices
            .UseWorldCS = True
            x0 = .Item(0).x
            y0 = .Item(0).y
            z0 = .Item(0).Z
            x1 = .Item(i).x
            y1 = .Item(i).y
            z1 = .Item(i).Z
            x2 = .Item(nV - 1).x
            y2 = .Item(nV - 1).y
            z2 = .Item(nV - 1).Z
        End With
        GoTo LL
    End If
LL:
    If Abs(z0) < Eps And Abs(z1) < Eps And Abs(z2) < Eps Then
        Set Gr1 = Nothing
        WorkPlaneEquation = 1
        Exit Function
    End If

    aa = (y1 - y0) * (z2 - z0) - (y2 - y0) * (z1 - z0)
    bb = (z1 - z0) * (x2 - x0) - (x1 - x0) * (z2 - z0)
    cc = (x1 - x0) * (y2 - y0) - (x2 - x0) * (y1 - y0)
    ff = Sqr(aa * aa + bb * bb + cc * cc)
    dd = (aa * x0 + bb * y0 + cc * z0) / ff
    aa = aa / ff
    bb = bb / ff
    cc = cc / ff

        GrSel.RotateAbsolute xBeg + aa, yBeg + bb, zBeg + cc, xBeg, yBeg, zBeg + 1, xBeg, yBeg, zBeg
        GrSel.MoveRelative 0, 0, -zBeg
'    Vi.Refresh
'    MsgBox ("aa=" & CStr(aa) & " bb=" & CStr(bb) & "  cc=" & CStr(cc))

Dim j As Long
    For i = 0 To ChildCount - 1
        Set Gr1 = GrSel.Graphics(i)
        With Gr1.Vertices
            nV = .Count
            .UseWorldCS = True
            For j = 0 To nV - 1
                .Item(j).Z = 0
            Next j
        End With
    Next i

    WorkPlaneEquation = 2
    Exit Function
LLLL:
   Set Gr1 = Nothing
    WorkPlaneEquation = 0
End Function

'******************************************************
' Join Selected objects to group

Private Sub SelectionToGroup(Sel1 As GraphicSet)
'MsgBox ("Begin SelectionToGroup")
Dim ResCount As Long
    ResCount = 0
Dim GrResID(1000) As Long

Dim SelCount As Long, i As Long
Dim Gr1 As Graphic
Dim Vers As Vertices
Dim nV As Long, j As Long
    NumSetID = 0
    Set Grs = Sel1.Drawing.Graphics
    SelCount = Sel1.Count
'MsgBox (CStr(SelCount))
Dim TakePart() As Boolean
ReDim TakePart(SelCount)
    For i = 0 To SelCount - 1
        TakePart(i) = False
    Next i
Dim GrType As String
    For i = 0 To SelCount - 1
        Set Gr1 = Sel1(i)
        GrType = Gr1.Type
        If GrType <> ARCTYPE And Gr1.Closed = True Then
            TakePart(i) = True
        End If
        If GrType = ARCTYPE Or GrType = GRAPHICTYPE Or GrType = "TCW50Polyline" Or GrType = "TCW30CURVE" Then
        Else
           TakePart(i) = True
        End If
        If GrType = "TCW50Polyline" Then
            If Gr1.Graphics(0).Properties("Info") = "Line_Width_Cosmetic" Then
                TakePart(i) = True
            End If
        End If
        If actDr.Properties("TileMode") = 1 Then
Dim Thickness#
            Thickness = 1
            On Error Resume Next
            Thickness = Gr1.Properties("Thickness")
            If Thickness <> 0 Then
                TakePart(i) = True
'            Else
'                TakePart(i) = False
            End If
        End If
        If GrType = GRAPHICTYPE And Gr1.Graphics.Count > 0 Then TakePart(i) = True
        If GrType = GRAPHICTYPE Then
            Set Vers = Gr1.Vertices
            nV = Vers.Count
            For j = 1 To nV - 1
                If Vers(j).PenDown = False Then
                    TakePart(i) = True
                    Exit For
                End If
            Next j
        End If
        Set Gr1 = Nothing
    Next i
Dim CountFalse As Long
    CountFalse = 0
    For i = 0 To SelCount - 1
        If TakePart(i) = False Then CountFalse = CountFalse + 1
    Next i
'MsgBox (CStr(CountFalse))
    If CountFalse < 2 Then
        Set Vers = Nothing
        Set Gr1 = Nothing
        Exit Sub
    End If
    ' Start UNDO
'    Sel1.Drawing.Graphics.Unselect
    hDr = TCWDrawingActive
'    TCWUndoRecordStart hDr, "JointPolyline"  '!!!!!!!!!!!
Dim BegEndPoint() As SelInfo
ReDim BegEndPoint(SelCount)
    For i = 0 To SelCount - 1
        If TakePart(i) = False Then
            BegEndPoint(i).nV = 2
ReDim BegEndPoint(i).xV(2)
ReDim BegEndPoint(i).yV(2)
            Set Gr1 = Sel1(i)
            Set Vers = Gr1.Vertices
            nV = Vers.Count
            Vers.UseWorldCS = False
            If Gr1.Type = ARCTYPE Then
                With BegEndPoint(i)
                    .xV(0) = Vers(1).x
                    .xV(1) = Vers(2).x
                    .yV(0) = Vers(1).y
                    .yV(1) = Vers(2).y
                End With
            Else
                With BegEndPoint(i)
                    .xV(0) = Vers(0).x
                    .xV(1) = Vers(nV - 1).x
                    .yV(0) = Vers(0).y
                    .yV(1) = Vers(nV - 1).y
                End With
            End If
        End If
    Next i

' Creaate single group from connected at the anded points graphics
Dim GrGroup As Graphic, iFirst As Long, GrDup As Graphic
Dim UnDirection As Boolean 'Revers from begining point
Dim hGrFirst As Long, hGroup As Long, hGrNext As Long
Dim hMat1 As Long, hMatNext As Long

LBEG0:
    UnDirection = False
    For i = 0 To SelCount - 1
        If TakePart(i) = False Then
            Set Gr1 = Sel1(i)
            SetID(NumSetID) = Gr1.ID
            NumSetID = NumSetID + 1
            hGrFirst = TCWGraphicAt(hDr, Gr1.Index)
            hMat1 = GraphicGetMatrix(hGrFirst)
'MsgBox ("hMat1=" & CStr(hMat1))
            iFirst = i
            TakePart(i) = True
            Set GrDup = Gr1.Duplicate
            GrDup.Properties("PenColor") = QBColor(13)
            Grs.Remove GrDup.Index
            Set GrGroup = Grs.Add(11)
            If actDr.Properties("TileMode") = 1 Then
                GrGroup.Properties("Thickness") = 0
            End If
            hGroup = TCWGraphicAt(hDr, GrGroup.Index)
            GraphicSetMatrix hGroup, hMat1
            GrGroup.Graphics.AddGraphic GrDup
            GoTo LL
        End If
    Next i
' End UNDO ************************************
Dim hGr As Long
'    TCWUndoRecordStart hDr, "Join Polyline"  '!!!!!!!!!!!
    TCWUndoRecordStart hDr, LoadResString(105) '!!!!!!!!!!!
    For i = 0 To ResCount - 1
        Set GrRes = Grs.GraphicFromID(GrResID(i))
        hGr = TCWGraphicAt(hDr, GrRes.Index)
        TCWUndoRecordAddGraphic hDr, hGr
    Next i
Dim GrDel() As Long
ReDim GrDel(NumSetID)
Dim GrID As Long
Dim Exist As Boolean
    Exist = False
Dim k As Long
    k = 0
    GrDel(k) = SetID(0)
    For i = 1 To NumSetID - 1
        Exist = False
        GrID = SetID(i)
        For j = 0 To k
            If GrID = GrDel(j) Then
                Exist = True
            End If
        Next j
        If Exist = False Then
            k = k + 1
            GrDel(k) = GrID
        End If
    Next i
    If Checked(0) = True Then
        If k > 0 Then
            For i = 0 To k
'MsgBox (CStr(GrDel(i)))
                Set GrDup = Grs.GraphicFromID(GrDel(i))
                If GrDup.Layer.Editable = True Then
                    hGr = TCWGraphicAt(hDr, GrDup.Index)
                    TCWUndoRecordAddGraphic hDr, hGr
                End If
            Next i
            For i = 0 To k
                Set GrDup = Grs.GraphicFromID(GrDel(i))
                If GrDup.Layer.Editable = True Then
                    GrDup.Deleted = True
                End If
            Next i
        End If

        TCWUndoRecordEnd hDr
    Else
        TCWUndoRecordEnd hDr
    End If
'*************************************************
    Set Vers = Nothing
    Set Gr1 = Nothing
    Set GrDup = Nothing
    Set GrGroup = Nothing

    Exit Sub '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

LL:
Dim xBeg#, yBeg#, xEnd#, yEnd#, xBeg0#, yBeg0#
    xBeg = BegEndPoint(iFirst).xV(0)
    yBeg = BegEndPoint(iFirst).yV(0)
    xEnd = BegEndPoint(iFirst).xV(1)
    yEnd = BegEndPoint(iFirst).yV(1)
    xBeg0 = xBeg
    yBeg0 = yBeg
'MsgBox ("xbeg=" & CStr(xBeg) & " ybeg=" & CStr(yBeg) & "  xend=" & CStr(xEnd) & " yend=" & CStr(yEnd))
Dim x0#, y0#, x1#, y1#
Dim nCon As Long, iCon As Long
LLL:
    nCon = 0
    For i = 0 To SelCount - 1
        If i <> iFirst And TakePart(i) = False Then
            x0 = BegEndPoint(i).xV(0)
            y0 = BegEndPoint(i).yV(0)
            x1 = BegEndPoint(i).xV(1)
            y1 = BegEndPoint(i).yV(1)
            If (Abs(x0 - xEnd) < Eps And Abs(y0 - yEnd) < Eps) Or (Abs(x1 - xEnd) < Eps And Abs(y1 - yEnd) < Eps) Then
                Set Gr1 = Sel1(i)
                hGrNext = TCWGraphicAt(hDr, Gr1.Index)
                hMatNext = GraphicGetMatrix(hGrNext)
'MsgBox ("hMatNext=" & CStr(hMatNext))
Dim Res1 As Boolean
                Res1 = MatrixEqual(hMatNext, hMat1)
                If Res1 = 1 Then
                    nCon = nCon + 1
                    iCon = i
                End If
            End If
        End If
    Next i

    If nCon = 1 Then
        i = iCon
        iFirst = i
        x0 = BegEndPoint(i).xV(0)
        y0 = BegEndPoint(i).yV(0)
        x1 = BegEndPoint(i).xV(1)
        y1 = BegEndPoint(i).yV(1)
        Set Gr1 = Sel1(i)
        SetID(NumSetID) = Gr1.ID
        NumSetID = NumSetID + 1
        Set GrDup = Gr1.Duplicate
        GrDup.Properties("PenColor") = QBColor(13)
        Grs.Remove GrDup.Index
        GrGroup.Graphics.AddGraphic GrDup
        TakePart(i) = True
        If Abs(x0 - xEnd) < Eps And Abs(y0 - yEnd) < Eps Then
            xEnd = x1
            yEnd = y1
        Else
            xEnd = x0
            yEnd = y0
        End If
        GoTo LLL
    End If

    If UnDirection = False Then
        UnDirection = True
'MsgBox ("!!!!!! XBeg0=" & CStr(xBeg0) & "  ybeg0=" & CStr(yBeg0))
'MsgBox ("!!!!!! Xend=" & CStr(xEnd) & "  yend=" & CStr(yEnd))
'MsgBox ("1111===" & CStr(GrGroup.Graphics.Count))
        x0 = xBeg0
        y0 = yBeg0
        xBeg0 = xEnd
        yBeg0 = yEnd
        xEnd = x0
        yEnd = y0
        Call GroupToGroup(GrGroup)
        GoTo LLL
    Else
'MsgBox ("2222====" & CStr(GrGroup.Graphics.Count))
        If GrGroup.Graphics.Count < 2 Then
            GrGroup.Deleted = True
            If GrGroup.Graphics.Count = 1 Then NumSetID = NumSetID - 1
        Else
'MsgBox ("2222====" & CStr(GrGroup.Graphics.Count))

'MsgBox ("XBeg0=" & CStr(xBeg0) & "  yBeg0=" & CStr(yBeg0))

            Call Polyline50NewNew(GrGroup, xBeg0, yBeg0)
            GrResID(ResCount) = GrRes.ID
            ResCount = ResCount + 1

'            hGr = TCWGraphicAt(hDr, GrRes.Index)
'            TCWUndoRecordAddGraphic hDr, hGr

            GrGroup.Deleted = True
'MsgBox ("111")

        End If
        GoTo LBEG0
    End If
' MsgBox ("2222")
'    TCWUndoRecordEnd hDr
End Sub

Private Sub SetOldColors()
Dim GrSetCount As Long, i As Long
    GrSetCount = GrSet.Count
    If GrSetCount > 0 And NumSetID > 0 Then
        For i = 0 To NumSetID - 1
            Set Gr = GrSet(i)
            Gr.Properties("PenColor") = OldSetColor(i)
            Gr.Draw
        Next i
    End If
End Sub

Public Function MouseMove(WhichDrawing As Drawing, WhichView As View, WhichWindow As Window, Shift As Long, x As Long, y As Long, Cancel As Boolean)
    theToolEvents.ToolChangePrompt Me, "", False
'    theToolEvents.ToolChangePrompt Me, "Open a local menu to choose Finish or Cancel", False
    theToolEvents.ToolChangePrompt Me, LoadResString(121), False
End Function

Public Function BeforeDoubleClick(WhichDrawing As Drawing, WhichView As View, WhichWindow As Window, Sel As Selection, Cancel As Boolean)
    Cancel = True
End Function
Public Function MouseUp(WhichDrawing As Drawing, WhichView As View, WhichWindow As Window, Button As ImsiMouseButton, Shift As Long, x As Long, y As Long, Cancel As Boolean)
   Cancel = True
End Function

' Create the ImsiPolyline from member of the Group

Private Sub Polyline50NewNew(GrSel As Graphic, xBeg0 As Double, yBeg0 As Double)
Dim SelCount As Long
    SelCount = GrSel.Graphics.Count
'MsgBox ("SelCount=" & CStr(SelCount))
Dim i As Long, j As Long
Dim nV As Long
Dim xV#, yV#
Dim xj#, yj#, xj1#, yj1#
Dim xB#, yB#, xE#, yE#
Dim GrType As String
Dim Vers As Vertices
Dim Ver As Vertex
Dim VerIndex As Long
Dim VerIn As Long
        VerIn = -1
'Dim GrRes As Graphic
Dim xEnd#, yEnd#
Dim GrSet1 As GraphicSet

    ' set WorkPlane matrix to GrRes - graphic
    hDr = TCWDrawingActive()
Dim hGrGroup As Long, hMatGroup As Long, hGr As Long
    hGrGroup = TCWGraphicAt(hDr, GrSel.Index)
    hMatGroup = GraphicGetMatrix(hGrGroup)
    Set GrRes = Grs.Add(, "TCW50Polyline")

'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Add Default properties to Polyline
Dim GrLine As Graphic, Props As Properties, Prop As Property
    Set GrLine = Grs.AddLineSingle(1, 1, 0, 2, 2, 0)
    Set Props = GrLine.Properties
Dim PropCount As Long
    PropCount = Props.Count
    For i = 0 To PropCount - 1
        Set Prop = Nothing
        On Error Resume Next
        Set Prop = Props(i)
        If Prop Is Nothing Then

        Else
            GrRes.Properties(i) = Props(i)
        End If
    Next i
    GrLine.Deleted = True
    Set Prop = Nothing
    Set Props = Nothing
    Set GrLine = Nothing
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

    If actDr.Properties("TileMode") = 1 Then
        GrRes.Properties("Thickness") = 0
    End If
    hGr = TCWGraphicAt(hDr, GrRes.Index)
    GraphicSetMatrix hGr, hMatGroup

    GrRes.Vertices.UseWorldCS = False
Dim GrIndex As Long
    GrIndex = GrRes.Index
Dim hVer As Long
 Dim PolyArc As ArcData
 Dim Icen As Long
' Dim DataArc(10)
 Dim GrExplode As Graphic

'#####################################################################
'#####################################################################
'#####################################################################
    xEnd = xBeg0
    yEnd = yBeg0
Dim j0 As Long
    For i = 0 To SelCount - 1
        Set Gr = GrSel.Graphics(i)
        Gr.Properties("BrushStyle") = ""
        If i = 0 Then
            If NumSetID > 0 Then
                GrRes.Properties("PenColor") = OldSetColor(0)
            End If
            GrRes.Properties("PenWidth") = Gr.Properties("PenWidth")
            GrRes.Layer = Gr.Layer
        End If
        If Gr.Type = GRAPHICTYPE Then
            Set Vers = Gr.Vertices
            nV = Vers.Count
            Vers.UseWorldCS = False
            With Vers
                xB = .Item(0).x
                yB = .Item(0).y
                xE = .Item(nV - 1).x
                yE = .Item(nV - 1).y

                If Abs(xB - xEnd) < Eps And Abs(yB - yEnd) < Eps Then
                    If i = 0 Then
                        j0 = 0
                    Else
                        j0 = 1
                    End If
                    For j = j0 To nV - 1
                        xj = Vers(j).x
                        yj = Vers(j).y
                        GrRes.Vertices.Add xj, yj, 0
                    Next j
                    xEnd = xE
                    yEnd = yE
                Else
                    If i = 0 Then
                        j0 = nV - 1
                    Else
                        j0 = nV - 2
                    End If
                    For j = j0 To 0 Step -1
                        xj1 = Vers(j).x
                        yj1 = Vers(j).y
                        GrRes.Vertices.Add xj1, yj1, 0
                    Next j
                    xEnd = xB
                    yEnd = yB
                End If
            End With
        End If
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
' ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC
Dim x1#, y1#, z1#, xc#, yc#, zc#, R#, r2#, r3#, xMid#, yMid#, Rot%, xDir#, yDir#
Dim XBA#, yBA#, XEA#, yEA#
         If Gr.Type = ARCTYPE Then
Dim ArcData(10) As Double
            Gr.GetArcData ArcData
            If Abs(Abs(ArcData(6)) - 1) > Eps Then GoTo ELLIPBEG

            Set Vers = Gr.Vertices
            Vers.UseWorldCS = False
            With Vers
                XBA = .Item(1).x
                yBA = .Item(1).y
                XEA = .Item(2).x
                yEA = .Item(2).y
                xDir = .Item(3).x
                yDir = .Item(3).y
                xc = .Item(0).x
                yc = .Item(0).y
                R = Sqr((XBA - xc) ^ 2 + (yBA - yc) ^ 2)
                Rot = ArcRotation(XBA, yBA, xDir, yDir, xc, yc, R)
                Call ArcMiddlePoint(xc, yc, XBA, yBA, XEA, yEA, R, Rot, xMid, yMid)

                If Abs(XBA - xEnd) < Eps And Abs(yBA - yEnd) < Eps Then
                    If i = 0 Then
                        GrRes.Vertices.Add XBA, yBA, 0
                    End If

                    Set Ver = GrRes.Vertices.Add(xc, yc, 0)
                    Ver.Bulge = True

                    Set Ver = GrRes.Vertices.Add(xMid, yMid, 0)
                    Ver.Bulge = True

                    GrRes.Vertices.Add XEA, yEA, 0

                    xEnd = XEA
                    yEnd = yEA
                Else
                    If i = 0 Then
                        GrRes.Vertices.Add XEA, yEA, 0
                    End If

                    Set Ver = GrRes.Vertices.Add(xc, yc, 0)
                    Ver.Bulge = True

                    Set Ver = GrRes.Vertices.Add(xMid, yMid, 0)
                    Ver.Bulge = True

                    GrRes.Vertices.Add XBA, yBA, 0

                    xEnd = XBA
                    yEnd = yBA
                End If
            End With
            GoTo ELLIPEND
        End If

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
' TCW50Polyline  TCW50Polyline  TCW50Polyline  TCW50Polyline
Dim iiNum As Long, Res As Boolean, ii As Long
Dim Ver0 As Vertex, Ver1 As Vertex, Ver2 As Vertex, Ver3 As Vertex, Ver4 As Vertex

    If Gr.Type = "TCW50Polyline" Then
        Gr.Update
        Set Vers = Gr.Vertices
        nV = Vers.Count
        With Vers
            xB = .Item(0).x
            yB = .Item(0).y
            xE = .Item(nV - 1).x
            yE = .Item(nV - 1).y
            If Abs(xB - xEnd) < Eps And Abs(yB - yEnd) < Eps Then
                If i = 0 Then
                    GrRes.Vertices.Add xB, yB, 0
                End If
                nV = Vers.Count
                j = 0
                While j < nV - 1
                    Set Ver0 = Vers(j)
                    Set Ver1 = Vers(j + 1)
                    If Ver0.Bulge = False And Ver1.Bulge = False Then
                        xj = Ver1.x
                        yj = Ver1.y
                        GrRes.Vertices.Add xj, yj, 0
                        j = j + 1
                    End If
                    If Ver0.Bulge = False And Ver1.Bulge = True Then
                        Set Ver2 = Vers(j + 2)
                        Set Ver3 = Vers(j + 3)
                        XBA = Ver0.x
                        yBA = Ver0.y
                        xc = Ver1.x
                        yc = Ver1.y
                        xDir = Ver2.x
                        yDir = Ver2.y
                        XEA = Ver3.x
                        yEA = Ver3.y
                        R = Sqr((XBA - xc) ^ 2 + (yBA - yc) ^ 2)
                        Rot = ArcRotation(XBA, yBA, xDir, yDir, xc, yc, R)
                        Call ArcMiddlePoint(xc, yc, XBA, yBA, XEA, yEA, R, Rot, xMid, yMid)

                        Set Ver = GrRes.Vertices.Add(xc, yc, 0)
                        Ver.Bulge = True

                        Set Ver = GrRes.Vertices.Add(xMid, yMid, 0)
                        Ver.Bulge = True

                        GrRes.Vertices.Add XEA, yEA, 0
                        j = j + 3

                    End If
                Wend

                xEnd = xE
                yEnd = yE
            Else
                If i = 0 Then
                    GrRes.Vertices.Add xE, yE, 0
                End If

                nV = Vers.Count
                j = nV - 1
                While j > 0
                    Set Ver0 = Vers(j)
                    Set Ver1 = Vers(j - 1)
                    If Ver0.Bulge = False And Ver1.Bulge = False Then
                        xj = Ver1.x
                        yj = Ver1.y
                        GrRes.Vertices.Add xj, yj, 0
                        j = j - 1
                    End If
                    If Ver0.Bulge = False And Ver1.Bulge = True Then
                        Set Ver2 = Vers(j - 2)
                        Set Ver3 = Vers(j - 3)
                        XBA = Ver3.x
                        yBA = Ver3.y
                        xc = Ver2.x
                        yc = Ver2.y
                        xDir = Ver1.x
                        yDir = Ver1.y
                        XEA = Ver0.x
                        yEA = Ver0.y
                        R = Sqr((XBA - xc) ^ 2 + (yBA - yc) ^ 2)
                        Rot = ArcRotation(XBA, yBA, xDir, yDir, xc, yc, R)
                        Call ArcMiddlePoint(xc, yc, XBA, yBA, XEA, yEA, R, Rot, xMid, yMid)

                        Set Ver = GrRes.Vertices.Add(xc, yc, 0)
                        Ver.Bulge = True

                        Set Ver = GrRes.Vertices.Add(xMid, yMid, 0)
                        Ver.Bulge = True

                        GrRes.Vertices.Add XBA, yBA, 0
                        j = j - 3

                    End If
                Wend

                xEnd = xB
                yEnd = yB
            End If
        End With
    End If
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
' "TCW30CURVE" "TCW30CURVE" "TCW30CURVE" "TCW30CURVE" "TCW30CURVE"
 Dim VersCosm As Vertices, nVCosm As Long
    If Gr.Type = "TCW30CURVE" Then
        Set Vers = Gr.Vertices
        nV = Vers.Count
        Vers.UseWorldCS = False
        With Vers
            xj = .Item(0).x
            yj = .Item(0).y
            xj1 = .Item(nV - 1).x
            yj1 = .Item(nV - 1).y
        End With
Dim jCosm As Long
        For j = 0 To Gr.Graphics.Count - 1
            If Gr.Graphics(j).Type = GRAPHICTYPE Then
                jCosm = j
                Exit For
            End If
        Next j
        Set VersCosm = Gr.Graphics(jCosm).Vertices
        VersCosm.UseWorldCS = False
        With VersCosm
            If Abs(xj - xEnd) < Eps And Abs(yj - yEnd) < Eps Then
                If i = 0 Then
                    GrRes.Vertices.Add xj, yj, 0
                End If
                nVCosm = VersCosm.Count
                    For j = 1 To nVCosm - 1
                        xV = .Item(j).x
                        yV = .Item(j).y
                        GrRes.Vertices.Add xV, yV, 0
                        VerIn = VerIn + 1
                    Next j
                xEnd = xj1
                yEnd = yj1
            Else
                If i = 0 Then
                    GrRes.Vertices.Add xj1, yj1, 0
                End If
                nVCosm = VersCosm.Count
                    For j = nVCosm - 2 To 0 Step -1
                        xV = .Item(j).x
                        yV = .Item(j).y
                        GrRes.Vertices.Add xV, yV, 0
                    Next j
                xEnd = xj
                yEnd = yj
            End If
        End With

    End If

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
' ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC  ARC
' Elliptical Arc
ELLIPBEG:
    If Gr.Type = ARCTYPE Then
'        Set GrDup = Gr.Duplicate
'        Grs.Remove GrDup.Index
'        Set GrSet1 = GrDup.Explode
        Set GrExplode = Gr.Explode(0)
        Set Vers = GrExplode.Vertices
        nV = Vers.Count
        Vers.UseWorldCS = False
        With Vers
            xj = .Item(0).x
            yj = .Item(0).y
            xj1 = .Item(nV - 1).x
            yj1 = .Item(nV - 1).y
            If Abs(xj - xEnd) < Eps And Abs(yj - yEnd) < Eps Then
                If i = 0 Then
                    GrRes.Vertices.Add xj, yj, 0
                End If

                nV = Vers.Count
                For j = 1 To nV - 1
                    xV = .Item(j).x
                    yV = .Item(j).y
                    GrRes.Vertices.Add xV, yV, 0
                Next j
                xEnd = xj1
                yEnd = yj1
            Else
                If i = 0 Then
                    GrRes.Vertices.Add xj1, yj1, 0
                End If
                nV = Vers.Count
                For j = nV - 2 To 0 Step -1
                    xV = .Item(j).x
                    yV = .Item(j).y
                    GrRes.Vertices.Add xV, yV, 0
                Next j
                xEnd = xj
                yEnd = yj
            End If
        End With
'        GrExplode.Deleted = True
'        GrSet1.Clear
'        GrSet1.Delete
        Set GrSet1 = Nothing
    End If
'#####################################################################
ELLIPEND:
    Next i

'    MsgBox ("end")
    If Abs(xBeg0 - xEnd) < Eps And Abs(yBeg0 - yEnd) < Eps Then
        GrRes.Closed = True
    End If

' Delete vertices if lines coincident and parallel
Dim xj2#, yj2#, L#, xLocj2#, yLocj2#, sina#, cosa#
TTTT:
    Set Vers = GrRes.Vertices
    nV = Vers.Count
    If nV > 2 Then
        For j = 0 To nV - 3
            Set Ver0 = Vers(j)
            Set Ver1 = Vers(j + 1)
            If Ver0.Bulge = False And Ver1.Bulge = False Then
                xj = Ver0.x
                yj = Ver0.y
                xj1 = Ver1.x
                yj1 = Ver1.y
                L = Sqr((xj1 - xj) ^ 2 + (yj1 - yj) ^ 2)
                If L < Eps Then
                    Ver1.Delete
                    GoTo TTTT
                End If
            End If

            Set Ver2 = Vers(j + 2)
            If Ver1.Bulge = False And Ver2.Bulge = False Then
                xj = Ver1.x
                yj = Ver1.y
                xj1 = Ver2.x
                yj1 = Ver2.y
                L = Sqr((xj1 - xj) ^ 2 + (yj1 - yj) ^ 2)
                If L < Eps Then
                    Ver1.Delete
                    GoTo TTTT
                End If
            End If

            If Ver0.Bulge = False And Ver1.Bulge = False And Ver2.Bulge = False Then
                xj = Ver0.x
                yj = Ver0.y
                xj1 = Ver1.x
                yj1 = Ver1.y

                xj2 = Ver2.x
                yj2 = Ver2.y
                L = Sqr((xj1 - xj) ^ 2 + (yj1 - yj) ^ 2)
                If L < Eps Then
                    Ver1.Delete
                    GoTo TTTT
                End If
                sina = (yj1 - yj) / L
                cosa = (xj1 - xj) / L
                yLocj2 = (yj2 - yj) * cosa - (xj2 - xj) * sina
                xLocj2 = (yj2 - yj) * sina + (xj2 - xj) * cosa
                If Abs(yLocj2) < Eps And xLocj2 > L + Eps Then
                    Ver1.Delete
                    GoTo TTTT
                End If
            End If
            If Ver0.Bulge = False And Ver1.Bulge = True And Ver2.Bulge = True Then
                Set Ver3 = Vers(j + 3)
                xj = Ver0.x
                yj = Ver0.y
                xj1 = Ver3.x
                yj1 = Ver3.y
                L = Sqr((xj1 - xj) ^ 2 + (yj1 - yj) ^ 2)
                If L < Eps Then
                    Ver3.Delete
                    Ver2.Delete
                    Ver1.Delete
                    GoTo TTTT
                End If

            End If
        Next j
    End If
    On Error Resume Next
    GrRes.Update
    Set Ver0 = Nothing
    Set Ver1 = Nothing
    Set Ver2 = Nothing
    Set VersCosm = Nothing
    Set Vers = Nothing
'    Set GrCosm = Nothing
    Set GrExplode = Nothing
'    Set GrDup = Nothing
'MsgBox ("Finish Polyline")

End Sub

' Define the middle point of Base Arc
' from Beg-End Points and Rot
' Rot=1 - Counter Clockwise
' Rot=-1 - Clockwise
Private Sub ArcMiddlePoint(xc As Double, yc As Double, xB As Double, yB As Double, xE As Double, yE As Double, R As Double, Rot As Integer, xMid As Double, yMid As Double)
    If Abs(R) < Eps Then
        xMid = xc
        yMid = yc
        Exit Sub
    End If

Dim sina#, cosa#
Dim fiBeg#, fiEnd#, fiMid#
    sina = (yB - yc) / R
    cosa = (xB - xc) / R
    fiBeg = Angle(sina, cosa)

    sina = (yE - yc) / R
    cosa = (xE - xc) / R
    fiEnd = Angle(sina, cosa)

    If Rot = 1 Then ' Counter Clockwise
        If fiBeg > fiEnd Then fiEnd = fiEnd - 2 * Pi
    Else    'Clockwise
        If fiBeg < fiEnd Then fiEnd = fiEnd - 2 * Pi
    End If

    fiMid = (fiBeg + fiEnd) / 2
    xMid = xc + R * Cos(fiMid)
    yMid = yc + R * Sin(fiMid)

End Sub

' Define the direction of Arc rotation
' return ArcRotation = 1 if CounterClockwise
' return ArcRotation = -1 if Clockwise

Private Function ArcRotation(xB As Double, yB As Double, xDir As Double, yDir As Double, xc As Double, yc As Double, R As Double) As Integer
Dim sina#, cosa# ', Alp0#, Alp1#
    sina = (yB - yc) / R
    cosa = (xB - xc) / R
Dim xLoc#, yLoc#
    xLoc = (yDir - yc) * sina + (xDir - xc) * cosa
    yLoc = (yDir - yc) * cosa - (xDir - xc) * sina
    If yLoc > 0 Then
        ArcRotation = 1
    Else
        ArcRotation = -1
    End If
End Function

Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function


Examples - Plane Figure Parameter Tool - Parameters.bas

Parameters.bas

Plane Figure Parameter Tool Example

Attribute VB_Name = "modParameters"
Option Explicit
Type ContGeo
    NVer As Long     ' Count of Vertices in object
    xVer() As Double  'coordinates of Vertices
    yVer() As Double
    GrInd As Long   ' Index of graphic in graphics collection
    Closed As Boolean  ' True - if object is closed
    xSum As Double     ' Sum of X-coordinates of vertices of the graphic
    ySum As Double
    Position As String ' position in resulting object - External or Internal
    xyMax(2) As Double ' Max cootdinates of extents of the object
    xyMin(2) As Double  ' Min cootdinates of extents of the object
    TakePart As Boolean  ' True - if object took part in operation
    GrType As String    ' Type of the graphic
    r As Double ' Rarius if Object Circle Or Arc
    xc As Double
    yc As Double
    Deleted() As Boolean
End Type
Type DDD
    LL As Double
    xx As Double
    yy As Double
    jj As Long
    jj1 As Long
    kk As Long
    Tangent As String
End Type

Type TTT
    Bet As Double
    jInit As Long
    kk As Long
    ddir As Integer
End Type

Type HorizInt
    xInt As Double
    yInt As Double
    ncont As Long
End Type
Type GrWithUnVis
    xVer() As Double
    yVer() As Double
    Pen() As Boolean
    TakePart() As Boolean
End Type
Type InitBrush
    nG As Long
    BrStyle() As String
    GrID() As Long
End Type

Global ContSel() As ContGeo
Global objApp As XApplication
Global Drs As Drawings
Global Dr As Drawing
Global Grs As Graphics
Global Gr As Graphic
Global Vis As Views
Global Vi As View
Global PRes As PickResult
Global PEnt As PickEntry
Global ContRes As ContGeo
Global Const Pi = 3.14159265359
Global Eps As Double
Global Const nVCirc = 61

Global xcT As Double
Global ycT As Double
Global JxcT As Double
Global JycT As Double
Global JxycT As Double
Global JpT As Double
Global WxcT As Double
Global WycT As Double
Global S0T As Double
Global SIntT As Double
Global KxT As Double
Global KyT As Double
Global JaxisT As Double
Global WaxisT As Double
Global DrUnit$

' 65

Sub Main()
End Sub


Examples - Plane Figure Parameter Tool - Parameters.cls

Parameters.cls

Plane Figure Parameter Tool Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Parameters"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'Number of tools in this server
Const NUM_TOOLS = 1
Private GrSets As GraphicSets
Private GrSet As GraphicSet
' *******************************************************************
'    Const EventMask = 1024 + 2048 + 4096 + 268435456 + 536870912
'    Const EventMask = 1024 + 268435456 + 536870912
    Const EventMask = 1 + 2 + 4 + 8 + 16 + 32 + 64 + 1024 + 2048 + 4096 + 262144 + 268435456 + 536870912

    Private iConnectId As Long
    Private iActTool As Long
    Private theToolEvents As IToolEvents
    Private Time0 As Variant
Private Captions(0 To 3) As String
Private Prompts(0 To 3) As String
Private Enabled(0 To 3) As Boolean
Private Checked(0 To 3) As Boolean

Private varCaptions As Variant
Private varPrompts As Variant
Private varEnabled As Variant
Private varChecked As Variant

Private xClick1#, yClick1#, xClick2#, yClick2#
Private FirstClick As Integer
Private x0Base#, y0Base#, x1Base#, y1Base#
Private GrAxis As Graphic
' *******************************************************************
'Toggle this to test loading buttons from .Bmp/.Res
Const boolLoadFromBmp As Boolean = False
Const boolDebug As Boolean = False
'##########################################################################
'##########################################################################

Private Declare Function TCWUndoRecordEnd Lib "TCAPI70.dll" (ByVal d As Long) As Long
Private Declare Function TCWUndoRecordStart Lib "TCAPI70.dll" (ByVal d As Long, ByRef title As String) As Long
Private Declare Function TCWUndoRecordAddGraphic Lib "TCAPI70.dll" (ByVal d As Long, ByVal g As Long) As Long
Private Declare Function TCWDrawingActive Lib "TCAPI70.dll" () As Long
Private Declare Function TCWGraphicAt Lib "TCAPI70.dll" (ByVal d As Long, ByVal Index As Long) As Long
Private Declare Function TCWViewActive Lib "TCAPI70.dll" () As Long
Private Declare Function TCWVertexAt Lib "TCAPI70.dll" (ByVal g As Long, ByVal Index As Long) As Long

Private Declare Function GraphicGetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long) As Long
Private Declare Function GraphicSetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long, ByVal hMat As Long) As Boolean
Private Declare Function WorkPlaneGetMatrix Lib "DBAPI70.dll" (ByVal hDr As Long) As Long
Private Declare Function MatrixEqual Lib "DBAPI70.dll" (ByVal hM1 As Long, ByVal hM2 As Long) As Boolean
Private Declare Function ViewportGetMatrix Lib "DBAPI70.dll" (ByVal hVi As Long) As Long

Private Declare Function WorldToWorkPlane Lib "DBAPI70.dll" (ByVal hDr As Long, ByVal hVerFrom As Long, ByVal hVerTo As Long, ByVal hVp As Long) As Boolean
Private Declare Function WorkPlaneToWorld Lib "DBAPI70.dll" (ByVal hDr As Long, ByVal hVerFrom As Long, ByVal hVerTo As Long, ByVal hVp As Long) As Boolean

Private hDr As Long
Private hVi As Long
Private hMWorkPlane As Long
Private hMViewPort As Long
Private Space As Long
Private xSc As Long
Private ySc As Long

'Private ThickDr#

'Copy a windows bitmap of the requested size to the clipboard
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire bitmap:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono bitmap should be 1-bit (black or white)
Public Function CopyBitmap(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Boolean
    On Error GoTo BitmapError

    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        'Put the image on the Windows clipboard
        Clipboard.SetData TheImage, vbCFDIB
        CopyBitmap = True
        Exit Function
    End If

BitmapError:
    CopyBitmap = False
End Function

'Return a Picture object for the requested size
'Apparently, returning references to StdPicture objects doesn't work for .EXE servers
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire image:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono image should be 1-bit (black or white)
Public Function GetPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Object
    On Error GoTo PictureError

    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        Set GetPicture = TheImage
        Exit Function
    End If

PictureError:
    Set GetPicture = Nothing
End Function

'Implementation specific stuff
'Private function to return the bitmap from .Res file or .Bmp file
Private Function GetButtonPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean, TheImage As StdPicture) As Boolean
    On Error GoTo LoadError

    'There are two ways to load images:  from .Bmp file(s) or from .RES resource.
    'In this demo, we control the loading by a private variable.

    'Note that if you are loading from .Bmp, or if you are running this tool as a
    '.VBP for debugging, you must place the .Res or .Bmp files in the Draggers subdirectory
    'of the directory in which TCW40.EXE (or IMSIGX40.DLL) is located.

    If boolLoadFromBmp Then
        'Load from .Bmp file
        Dim strFileName As String 'File name of .Bmp file to load

        If LargeImage Then
            strFileName = App.Path & "\button24.bmp"
        Else
            strFileName = App.Path & "\button16.bmp"
        End If
        Set TheImage = LoadPicture(strFileName)
    Else
        'Load from .Res file
        Dim idBitmap%  'BITMAP resource id in .Res file

        If LargeImage Then
            idBitmap% = 1002
        Else
            idBitmap% = 1001
        End If
        Set TheImage = LoadResPicture(idBitmap%, vbResBitmap)
    End If

    'Return the image
    GetButtonPicture = True
    Exit Function

LoadError:
    If boolDebug Then
'        MsgBox "Error loading bitmap: " & Err.Description
    End If
    GetButtonPicture = False
End Function

'Private Function GetLMPicture() As Object
Public Function GetLMPicture() As Object
Dim TheImage As StdPicture
'MsgBox ("1111")
    Set TheImage = LoadResPicture(1003, vbResBitmap)
    Set GetLMPicture = TheImage
End Function

'##########################################################################
'##########################################################################
'##########################################################################

'Return a description string for this package of tools
Public Property Get Description() As String
    Description = "Plane Figure Parameters"
End Property

'Called to perform tool function
Public Function Run(ByVal Tool As Object) As Boolean
    On Error GoTo ErrorHandler
Dim theXTool As Tool
    Set theXTool = Tool
    FirstClick = True
    x0Base = 0
    y0Base = 0
    x1Base = 0
    y1Base = 0
Dim i As Long, SelCount As Long
Dim Sel As Selection
    Set Sel = objApp.ActiveDrawing.Selection
    SelCount = Sel.Count
    For i = 0 To SelCount - 1
        Set Gr = Sel(0)
        Gr.Unselect
        Gr.Draw
    Next i
    Set Sel = Nothing
'    objApp.ActiveDrawing.Graphics.Unselect
    objApp.SnapModes = 0
    If iConnectId <> -1 Then
        objApp.DisconnectEvents iConnectId
        AddLM False
        iConnectId = -1
        iActTool = -1
        theToolEvents.ToolChangePrompt Me, "", False
    Else
        iConnectId = objApp.ConnectEvents(Me, EventMask)
 '       iActTool = theXTool.Index
        AddLM True
        theToolEvents.ToolChangePrompt Me, "Pick some closed graphic", False
    End If

    Exit Function
ErrorHandler:
 '   MsgBox Err.Msg
    Call Finish
End Function

'Fill arrays with information about tools in the package
'Return the number of tools in the package
Public Function GetToolInfo(CommandNames As Variant, MenuCaptions As Variant, StatusPrompts As Variant, _
    ToolTips As Variant, Enabled As Variant, WantsUpdates As Variant) As Long

    ReDim CommandNames(NUM_TOOLS)
    ReDim MenuCaptions(NUM_TOOLS, 2)
    ReDim StatusPrompts(NUM_TOOLS)
    ReDim ToolTips(NUM_TOOLS)
    ReDim Enabled(NUM_TOOLS)
    ReDim WantsUpdates(NUM_TOOLS)
    CommandNames(0) = "S&DK|&Utils|Geometric Parameters"

    MenuCaptions(0, 0) = "&Geometric Parameters"
    MenuCaptions(0, 1) = "SDK"
    ToolTips(0) = "Calculate Geometric Parameters"
    Enabled(0) = True
    WantsUpdates(0) = False
    GetToolInfo = NUM_TOOLS
End Function

'Public Function GetToolInfo(CommandNames As Variant, MenuCaptions As Variant, StatusPrompts As Variant, _
'    ToolTips As Variant, Enabled As Variant, WantsUpdates As Variant) As Long

'    ReDim CommandNames(NUM_TOOLS, 4)
'    ReDim MenuCaptions(NUM_TOOLS)
'    ReDim StatusPrompts(NUM_TOOLS)
'    ReDim ToolTips(NUM_TOOLS)
'    ReDim Enabled(NUM_TOOLS)
'    ReDim WantsUpdates(NUM_TOOLS)
'    CommandNames(0, 0) = "Modify|Pick Point " & "&" & " Hatch"
'    CommandNames(0, 1) = "Hatch Properties"
'    CommandNames(0, 2) = "Polyline"
'    CommandNames(0, 3) = "TCW50IntProp"
'    MenuCaptions(0) = "&Pick Point " & "&&" & " Hatch"
'    ToolTips(0) = "Pick Point " & "&&" & " Hatch"
'    Enabled(0) = True
'    WantsUpdates(0) = False
'    GetToolInfo = NUM_TOOLS
'End Function

'Returns true if tool is correctly initialized
Public Function Initialize(ByVal Tool As Object) As Boolean
On Error GoTo ErrorHandler
    Set objApp = Tool.Application
    Set theToolEvents = objApp
    iConnectId = -1
    iActTool = -1
    Initialize = True
    Exit Function
ErrorHandler:
 '   MsgBox Err.Description
End Function

'Returns true if tool is correctly initialized
Public Function UpdateToolStatus(ByVal Tool As Object, Enabled As Boolean, Checked As Boolean) As Boolean
    Enabled = True 'Could do a test here to determine whether to disable the button/menu item
    If iConnectId = -1 Then
        Checked = False  'Could do a test here to determine whether to check the button/menu item
    Else
        Checked = True
    End If
    UpdateToolStatus = True
End Function

Public Function RunTool(WhichTool As Tool)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Set GrSet = Nothing
    Set GrSets = Nothing
    Set Gr = Nothing
    Set Grs = Nothing
    Set PEnt = Nothing
    Set PRes = Nothing
    Set Vi = Nothing
    Set Vis = Nothing
    Set Dr = Nothing
    Set Drs = Nothing
End Function

Public Function BeforeExit(WhichApplication As Application, Cancel As Boolean)
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    Set GrSet = Nothing
    Set GrSets = Nothing
    Set Gr = Nothing
    Set Grs = Nothing
    Set PEnt = Nothing
    Set PRes = Nothing
    Set Vi = Nothing
    Set Vis = Nothing
    Set Dr = Nothing
    Set Drs = Nothing

End Function
Public Function DrawingNew(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Set GrSet = Nothing
    Set GrSets = Nothing
    Set Gr = Nothing
    Set Grs = Nothing
    Set PEnt = Nothing
    Set PRes = Nothing
    Set Vi = Nothing
    Set Vis = Nothing
    Set Dr = Nothing
    Set Drs = Nothing
End Function
Public Function DrawingOpen(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Set GrSet = Nothing
    Set GrSets = Nothing
    Set Gr = Nothing
    Set Grs = Nothing
    Set PEnt = Nothing
    Set PRes = Nothing
    Set Vi = Nothing
    Set Vis = Nothing
    Set Dr = Nothing
    Set Drs = Nothing
End Function
Public Function DrawingActivate(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Set GrSet = Nothing
    Set GrSets = Nothing
    Set Gr = Nothing
    Set Grs = Nothing
    Set PEnt = Nothing
    Set PRes = Nothing
    Set Vi = Nothing
    Set Vis = Nothing
    Set Dr = Nothing
    Set Drs = Nothing
End Function
Public Function DrawingDeactivate(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Set GrSet = Nothing
    Set GrSets = Nothing
    Set Gr = Nothing
    Set Grs = Nothing
    Set PEnt = Nothing
    Set PRes = Nothing
    Set Vi = Nothing
    Set Vis = Nothing
    Set Dr = Nothing
    Set Drs = Nothing
End Function
Public Function DrawingBeforeClose(WhichDrawing As Drawing, Cancel As Boolean)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Set GrSet = Nothing
    Set GrSets = Nothing
    Set Gr = Nothing
    Set Grs = Nothing
    Set PEnt = Nothing
    Set PRes = Nothing
    Set Vi = Nothing
    Set Vis = Nothing
    Set Dr = Nothing
    Set Drs = Nothing
End Function
Public Function DrawingBeforeSave(WhichDrawing As Drawing, SaveAs As Boolean, Cancel As Boolean)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
'    Cancel = True   '????
    Set GrSet = Nothing
    Set GrSets = Nothing
    Set Gr = Nothing
    Set Grs = Nothing
    Set PEnt = Nothing
    Set PRes = Nothing
    Set Vi = Nothing
    Set Vis = Nothing
    Set Dr = Nothing
    Set Drs = Nothing
End Function

Public Function MouseDown(WhichDrawing As Drawing, WhichView As View, WhichWindow As Window, Button As ImsiMouseButton, Shift As Long, x As Long, y As Long, Cancel As Boolean)
'MsgBox (CStr(objApp.SnapModes))

Dim xClick#, yClick#
On Error GoTo ErrorHandler
    Set Drs = objApp.Drawings
    Set Dr = WhichDrawing
    Set Grs = Dr.Graphics
    Set Vis = Dr.Views
    Set Vi = WhichView
    Vi.ScreenToView x, y, xClick, yClick

    Space = Dr.Properties("TileMode")
    hDr = TCWDrawingActive
    hMWorkPlane = WorkPlaneGetMatrix(hDr)
    hVi = TCWViewActive
    hMViewPort = ViewportGetMatrix(hVi)
    Time0 = Timer
    If Button = imsiLeftButton Then
        If iConnectId <> -1 Then
            Cancel = True
            theToolEvents.ToolChangePrompt Me, "", False
            If Checked(2) = True Then
                If FirstClick = 0 Then
                    xSc = x
                    ySc = y
                    FirstClick = 1
                    Vi.ViewToWorld xClick, yClick, 0, x0Base, y0Base, 0
Call NearestSnapPoint(-1, xClick, yClick, 1, x0Base, y0Base)
                    Set GrAxis = Grs.Add(11)
                    'GrAxis.Properties("PenStyle") = "Dashed"
                    GrAxis.Properties("PenColor") = RGB(255, 0, 0)

                    With GrAxis.Vertices
                        .Add x0Base, y0Base, 0
                        .Add x0Base, y0Base, 0
                    End With

                    theToolEvents.ToolChangePrompt Me, "", False
                    theToolEvents.ToolChangePrompt Me, "Pick second point of Axis", False
                    GoTo WWW
                End If
                If FirstClick = 1 Then
                    FirstClick = -1
                    Vi.ViewToWorld xClick, yClick, 0, x1Base, y1Base, 0
'                    GrAxis.Visible = False
'                    GrAxis.Draw
Call NearestSnapPoint(GrAxis.ID, xClick, yClick, 1, x1Base, y1Base)
                    GrAxis.Vertices(1).x = x1Base
                    GrAxis.Vertices(1).y = y1Base
                    GrAxis.Visible = True
                    GrAxis.Draw
                    theToolEvents.ToolChangePrompt Me, "", False
                    If Checked(0) = True Then
                        theToolEvents.ToolChangePrompt Me, "Pick some closed graphic", False
                    Else
                        theToolEvents.ToolChangePrompt Me, "Pick inside closed area", False
                    End If
                    GoTo WWW
                End If
                If FirstClick = -1 Then
                    FirstClick = 0
                    If Checked(0) = True Then
                        Call ClickOnObject(xClick, yClick)
                        GrAxis.Visible = False
                        GrAxis.Draw
                        GrAxis.Deleted = True
                    Else
                        Call PickArea(xClick, yClick)
                        GrAxis.Visible = False
                        GrAxis.Draw
                        GrAxis.Deleted = True
                    End If
                    theToolEvents.ToolChangePrompt Me, "", False
                    theToolEvents.ToolChangePrompt Me, "Pick first point of Axis", False
                    x0Base = 0
                    y0Base = 0
                    x1Base = 0
                    y1Base = 0

                    GoTo WWW
                End If
            End If
            x0Base = 0
            y0Base = 0
            x1Base = 0
            y1Base = 0
            If Checked(0) = True Then
                Call ClickOnObject(xClick, yClick)
                theToolEvents.ToolChangePrompt Me, "", False
                theToolEvents.ToolChangePrompt Me, "Pick some closed graphic", False
            Else
                Call PickArea(xClick, yClick)
                theToolEvents.ToolChangePrompt Me, "", False
                theToolEvents.ToolChangePrompt Me, "Pick inside closed area", False
            End If

WWW:
            Set Vi = Nothing
            Set Vis = Nothing
            Set Grs = Nothing
            Set Dr = Nothing
            Set Drs = Nothing

            Exit Function
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
            AddLM False
        End If
    Else
        Cancel = False
    End If
LLL:
    Set GrSet = Nothing
    Set GrSets = Nothing
    Set Gr = Nothing
    Set Grs = Nothing
    Set PEnt = Nothing
    Set PRes = Nothing
    Set Vi = Nothing
    Set Vis = Nothing
    Set Dr = Nothing
    Set Drs = Nothing

    Exit Function
ErrorHandler:
    If iConnectId <> -1 Then
        theToolEvents.ToolChangePrompt Me, "", False
        objApp.DisconnectEvents iConnectId
        iConnectId = -1
        AddLM False
    End If
    Set GrSet = Nothing
    Set GrSets = Nothing
    Set Gr = Nothing
    Set Grs = Nothing
    Set PEnt = Nothing
    Set PRes = Nothing
    Set Vi = Nothing
    Set Vis = Nothing
    Set Dr = Nothing
    Set Drs = Nothing

 '   MsgBox Err.Description
End Function

Public Function Cancel(DoItPlease As Boolean, CanCancel As Boolean)

    If (DoItPlease) Then
        If iConnectId <> -1 Then
            theToolEvents.ToolChangePrompt Me, "", False
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
        End If

        Set GrSet = Nothing
        Set GrSets = Nothing
        Set Gr = Nothing
        Set Grs = Nothing
        Set PEnt = Nothing
        Set PRes = Nothing
        Set Vi = Nothing
        Set Vis = Nothing
        Set Dr = Nothing
        Set Drs = Nothing

        theToolEvents.ToolChangePrompt Me, "", False
    End If

    CanCancel = True
End Function

Public Function UpdateUndo(AllowsUndo As Boolean)
    AllowsUndo = False
End Function

Private Function AddActToolLM(iTool As Long, bAdd As Boolean)
'    AddLM bAdd
End Function
Private Sub Class_Terminate()
    If (Not theToolEvents Is Nothing) Then
        Set theToolEvents = Nothing
    End If
    If (Not objApp Is Nothing) Then
        Set objApp = Nothing
    End If

End Sub

Private Function AddLM(bAdd As Boolean)

    If (bAdd) Then
        Captions(0) = "By closed graphic"
        Prompts(0) = "Set Geometric Parameters mode"
        Enabled(0) = True
        Checked(0) = True

        Captions(1) = "By closed area"
        Prompts(1) = "Set Geometric Parameters mode"
        Enabled(1) = True
        Checked(1) = False

        Captions(2) = "Relative Axis"
        Prompts(2) = "Define Parameters relative axis"
        Enabled(2) = True
        Checked(2) = False

        Captions(3) = "Finish Geometric Parameters"
        Prompts(3) = "Finish Geometric Parameters"
        Enabled(3) = True
        Checked(3) = False

        varCaptions = Captions
        varPrompts = Prompts
        varEnabled = Enabled
        varChecked = Checked

        theToolEvents.ToolChangeCommands Me, 4, varCaptions, varPrompts, varEnabled, varChecked, True
    Else
        theToolEvents.ToolChangeCommands Me, 0, , , , , False
    End If
End Function

Public Function DoLMCommand(CmdInd As Long)
'MsgBox ("CmdInd=" & CStr(CmdInd))
    If CmdInd = 2 Then ' Relative Axis
        x0Base = 0
        y0Base = 0
        x1Base = 0
        y1Base = 0
        If Checked(2) = False Then
            Checked(2) = True
            FirstClick = 0
            theToolEvents.ToolChangePrompt Me, "", False
            theToolEvents.ToolChangePrompt Me, "Pick first point of Axis", False
        Else
            Checked(2) = False
            FirstClick = -1
            theToolEvents.ToolChangePrompt Me, "", False
            If Checked(0) = True Then
                theToolEvents.ToolChangePrompt Me, "Pick some closed graphic", False
            Else
                theToolEvents.ToolChangePrompt Me, "Pick inside closed area", False
            End If
        End If
        varCaptions = Captions
        varPrompts = Prompts
        varEnabled = Enabled
        varChecked = Checked
        theToolEvents.ToolChangeCommands Me, 4, varCaptions, varPrompts, varEnabled, varChecked, True
    End If
    If CmdInd = 0 Then
        If Checked(2) = False Then
            x0Base = 0
            y0Base = 0
            x1Base = 0
            y1Base = 0
        End If
        If Checked(0) = False Then
            Checked(0) = True
            Checked(1) = False
            theToolEvents.ToolChangePrompt Me, "", False
            theToolEvents.ToolChangePrompt Me, "Pick some closed graphic", False
        Else
            Checked(0) = False
            Checked(1) = True
            theToolEvents.ToolChangePrompt Me, "", False
            theToolEvents.ToolChangePrompt Me, "Pick inside closed area", False
        End If
        varCaptions = Captions
        varPrompts = Prompts
        varEnabled = Enabled
        varChecked = Checked
        theToolEvents.ToolChangeCommands Me, 4, varCaptions, varPrompts, varEnabled, varChecked, True
   End If
    If CmdInd = 1 Then
        If Checked(2) = False Then
            x0Base = 0
            y0Base = 0
            x1Base = 0
            y1Base = 0
        End If
        If Checked(1) = False Then
            Checked(1) = True
            Checked(0) = False
            theToolEvents.ToolChangePrompt Me, "", False
            theToolEvents.ToolChangePrompt Me, "Pick inside closed area", False
        Else
            Checked(1) = False
            Checked(0) = True
            theToolEvents.ToolChangePrompt Me, "", False
            theToolEvents.ToolChangePrompt Me, "Pick some closed graphic", False
        End If
        varCaptions = Captions
        varPrompts = Prompts
        varEnabled = Enabled
        varChecked = Checked
        theToolEvents.ToolChangeCommands Me, 4, varCaptions, varPrompts, varEnabled, varChecked, True
   End If

   If CmdInd = 3 Then
        x0Base = 0
        y0Base = 0
        x1Base = 0
        y1Base = 0
        If iConnectId <> -1 Then
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
            AddLM False
        End If
        If GrAxis Is Nothing Then

        Else
            GrAxis.Visible = False
            GrAxis.Draw
            GrAxis.Deleted = True
        End If

        Set GrSet = Nothing
        Set GrSets = Nothing
        Set Gr = Nothing
        Set Grs = Nothing
        Set PEnt = Nothing
        Set PRes = Nothing
        Set Vi = Nothing
        Set Vis = Nothing
        Set Dr = Nothing
        Set Drs = Nothing

        theToolEvents.ToolChangePrompt Me, "", False
    End If

End Function

' Function creates closed contours

Private Function PickArea(x#, y#) As Boolean
On Error GoTo ErrorHandler
Dim nV As Long, i As Long, j As Long
Dim NumCont As Long, iCon As Long
    NumCont = -1
Dim Cont(500) As ContGeo
Dim xMax#, xMin#, yMax#, yMin#, dxMin#, xj#, yj#, xj1#, yj1#
    xMax = -10000000
    xMin = 10000000
    yMax = -10000000
    yMin = 10000000
' X,Y -View coordinates of the pick
'xMod,yMod - World coordinates of the pick
'dxMod,dyMod - difference betwen World and View coordinates

Dim xMod#, yMod#, zMod#, dxMod#, dyMod#
    ViewToWorkPlane x, y, 0, xMod, yMod, zMod
    dxMod = xMod - x
    dyMod = yMod - y

Dim Vers As Vertices
Dim Ver As Vertex
Dim xLeft#
    xLeft = x
'#######################################################
' Define difference between View and Local coordinates
Dim xV#, yV#, zV#, dxV#, dyV#
    WorkPlaneToView xMod + 1#, yMod, zMod, xV, yV, zV
    dxV = xV - x
    dyV = yV - y
    If Abs(dyV) < 0.001 Then
        zMod = 0#
    End If
    xMod = x + dxMod + Sign(dyV) * zMod ' if paper space dxMod,dyMod=0
    yMod = y + dyMod + Sign(dxV) * zMod 'zMod=0

'#######################################################
RRR:
    If InitNew(xLeft, y) = True Then
'MsgBox ("FirstContTrue")
        If ContNotArea(ContRes) = True Then
            NumCont = NumCont + 1
        Else
            xLeft = LeftPoint(ContRes, xMod, yMod)
'            xLeft = xLeft - dxMod - 1000 * Eps - Sign(dyV) * zMod
'            y = yMod - dyMod - 1000 * Eps - Sign(dxV) * zMod
            WorkPlaneToView xLeft - 1000 * Eps, yMod, 0, xV, yV, zV
            xV = xV - Vi.ViewWidth / 500
            xLeft = xV
            y = yV
'MsgBox ("ContNotAreaFalse")
            GoTo RRR
        End If

        Cont(NumCont) = ContRes
    Else
        GoTo RRR2
    End If
    If PointIntoContour(Cont(NumCont), xMod, yMod) = 1 Then
        Cont(NumCont).Position = "External"
'MsgBox ("External")
    Else
'MsgBox ("Internal")
        Cont(NumCont).Position = "Internal"
        xLeft = LeftPoint(Cont(NumCont), xMod, yMod)
'MsgBox ("xMod=" & CStr(xMod) & "  yMod=" & CStr(yMod) & "  xLeft=" & CStr(xLeft))
'MsgBox ("xLeft=" & CStr(xLeft))
'        xLeft = xLeft - dxMod - 100000 * Eps - Sign(dyV) * zMod
'        y = yMod - dyMod - 1000 * Eps - Sign(dxV) * zMod
        WorkPlaneToView xLeft, yMod, 0, xV, yV, zV
Dim st#, ViLeft#
        ViLeft = Vi.ViewLeft
        st = Vi.ViewWidth / 1000
        For xLeft = xV To ViLeft Step -st
            If Vi.PickPoint(xLeft, yV, st).Count = 0 Then Exit For
        Next xLeft
        xLeft = xLeft - 2 * st
        y = yV
        GoTo RRR
    End If
Dim iExt As Long ' Number of the external contour
    For i = 0 To NumCont
        If Cont(i).Position = "External" Then
            For j = 0 To Cont(i).NVer - 1
                If Cont(i).xVer(j) > xMax Then
                    xMax = Cont(i).xVer(j)
                End If
                If Cont(i).xVer(j) < xMin Then
                    xMin = Cont(i).xVer(j)
                End If
                If Cont(i).yVer(j) > yMax Then
                    yMax = Cont(i).yVer(j)
                End If
                If Cont(i).yVer(j) < yMin Then
                    yMin = Cont(i).yVer(j)
                End If
            Next j

            iExt = i
'MsgBox ("End External")
        End If
    Next i

 ' Selection all Contours inside created external contour with
 ' extents xMin,yMin  -  xMax,yMax
 Dim PResCount As Long, r#
    r = Sqr((xMax - xMin) * (xMax - xMin) + (yMax - yMin) * (yMax - yMin)) / 2
 '   Eps = (xMax - xMin) / 100000
    WorkPlaneToView (xMax + xMin) / 2, (yMax + yMin) / 2, 0, xV, yV, zV
    Set PRes = Vi.PickPoint(xV, yV, r, False, True, True, True, True, False)
    PResCount = PRes.Count
'MsgBox ("1111PResCount=" & CStr(PResCount))
    If PResCount < 1 Then GoTo RRR2
Dim ContInt() As ContGeo
Dim nInt As Long, k As Long
Dim GrSets1 As GraphicSets
Dim GrSet1 As GraphicSet
    nInt = -1
    Set GrSets1 = Dr.GraphicSets
    Set GrSet1 = GrSets1.Add
    Call PResToGrSet(PRes, GrSet1)
    PResCount = GrSet1.Count
'MsgBox ("2222PResCount=" & CStr(PResCount))

ReDim ContInt(PResCount)

    For i = 0 To PResCount - 1
        Set Gr = GrSet1.Item(i)
        Call InitPicRes(Gr, ContRes)
        For k = 0 To ContRes.NVer - 1
            xj = ContRes.xVer(k)
            yj = ContRes.yVer(k)
            If PointInsideContour(Cont(iExt), xj, yj) = 0 Then GoTo WW0
            For j = 0 To NumCont
                If PointIntoContour(Cont(j), xj, yj) = 1 And j <> iExt Then GoTo WW0
            Next j
        Next k
        nInt = nInt + 1
        ContInt(nInt) = ContRes
        ContInt(nInt).TakePart = False
WW0:
    Next i
    Call Projection(ContInt, nInt + 1)
    GrSet1.Clear
    Set GrSet1 = Nothing
    Set GrSets1 = Nothing
'MsgBox ("nInt=" & CStr(nInt))
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

Dim xMaxInt#, yMaxInt#, xMinInt#, yMinInt#, DeltaX#, iIntMax As Long
Dim xPick#, yPick#
'    Eps = 0.0001

WW3:
    DeltaX = 10000000
    For i = 0 To nInt
        If ContInt(i).TakePart = True Then GoTo WW1
        If ContInt(i).NVer = 2 And Abs(ContInt(i).yVer(0) - ContInt(i).yVer(1)) < Eps Then GoTo WW1
        xMaxInt = ContInt(i).xyMax(0)
        If xMax - xMaxInt < DeltaX Then
            DeltaX = xMax - xMaxInt
            iIntMax = i
        End If
WW1:
    Next i

    If DeltaX > 1000000 Then GoTo RRR1
    xMaxInt = ContInt(iIntMax).xyMax(0)
    yMaxInt = ContInt(iIntMax).xyMax(1)
    xMinInt = ContInt(iIntMax).xyMin(0)
    yMinInt = ContInt(iIntMax).xyMin(1)
    xPick = xMaxInt + 1000 * Eps
    yPick = (yMaxInt + yMinInt) / 2 '+ 1000 * Eps
    NumCont = NumCont + 1

    If InitSSS(ContInt(), nInt, xPick, yPick, Cont(NumCont)) = True Then
        For i = 0 To nInt
            If ContInt(i).TakePart = True Then GoTo WW2
            For j = 0 To 0 'ContInt(i).NVer - 1
                xj = ContInt(i).xVer(j)
                yj = ContInt(i).yVer(j)
                If PointIntoContour(Cont(NumCont), xj, yj) = 1 Then
                    ContInt(i).TakePart = True
                    GoTo WW2
                End If
            Next j
WW2:
        Next i
    Else
        NumCont = NumCont - 1
        GoTo RRR1
    End If
    If NumCont > 500 Then GoTo RRR2
GoTo WW3

RRR1:

'################################################################################
'################################################################################
'################################################################################
'################################################################################
'MsgBox ("NumCont=" & CStr(NumCont) & "  iExt=" & CStr(iExt))
'MsgBox ("Call HorizontalIntersection")

    Call DeleteTail(Cont, NumCont)

    Call HorizontalIntersection(Cont, NumCont, iExt)
    PickArea = True
    Set Ver = Nothing
    Set Vers = Nothing
    Set GrSet = Nothing
    Set GrSets = Nothing
'    Set GrGroup = Nothing
Exit Function
RRR2:
        Beep

        MsgBox "Operation can not be performed with these objects.", vbOKOnly, "Geometric Parameters"
'        MsgBox "Operation can not be performed with these objects.", , "Plane Figure Parameters"
        PickArea = False
    Set Ver = Nothing
    Set Vers = Nothing
    Set GrSet = Nothing
    Set GrSets = Nothing
Exit Function
'***********************************************************************************
'***********************************************************************************
'***********************************************************************************

ErrorHandler:
    Beep
    MsgBox "Operation can not be performed with these objects.", vbOKOnly, "Geometric Parameters"
'    MsgBox "Operation can not be performed with these objects.", , "Plane Figure Parameters"
    Set Ver = Nothing
    Set Vers = Nothing
    Set GrSet = Nothing
    Set GrSets = Nothing
    Call Finish

End Function

Private Sub Finish()
'    Set Gcont = Nothing
    Set GrSet = Nothing
    Set GrSets = Nothing
    Set Gr = Nothing
    Set Grs = Nothing
    Set PEnt = Nothing
    Set PRes = Nothing
    Set Vi = Nothing
    Set Vis = Nothing
    Set Dr = Nothing
    Set Drs = Nothing
'    Set objApp = Nothing
End Sub

Private Function PointIntoSegmentii(x1#, y1#, x2#, y2#, x#, y#) As Integer
Dim dx#, dy#, l#, sina#, cosa#
            PointIntoSegmentii = 0
            If Abs(x - x1) < 1 * Eps And Abs(y - y1) < 1 * Eps Then
                PointIntoSegmentii = 0
                Exit Function
            End If
            If Abs(x - x2) < Eps And Abs(y - y2) < Eps Then
                PointIntoSegmentii = 1
                Exit Function
            End If
Dim xLoc#, yLoc#
            dx = x2 - x1
            dy = y2 - y1
            l = Sqr(dx * dx + dy * dy)
            If l < Eps Then Exit Function
            sina = dy / l
            cosa = dx / l
            yLoc = (y - y1) * cosa - (x - x1) * sina
            xLoc = (y - y1) * sina + (x - x1) * cosa
            If Abs(yLoc) > 10 * Eps Then
                PointIntoSegmentii = 0
                Exit Function
            End If
            If xLoc > 0 And xLoc < l Then
                PointIntoSegmentii = 1
                Exit Function
            End If
End Function

Private Function PointIntoSegmentjj(x1#, y1#, x2#, y2#, x#, y#) As Integer
Dim dx#, dy#, l#, sina#, cosa#
            PointIntoSegmentjj = 0
            If Abs(x - x1) < Eps And Abs(y - y1) < Eps Then
                PointIntoSegmentjj = 1
                Exit Function
            End If
            If Abs(x - x2) < Eps And Abs(y - y2) < Eps Then
                PointIntoSegmentjj = 1
                Exit Function
            End If
Dim xLoc#, yLoc#
            dx = x2 - x1
            dy = y2 - y1
            l = Sqr(dx * dx + dy * dy)
            If l < Eps Then Exit Function
            sina = dy / l
            cosa = dx / l

            yLoc = (y - y1) * cosa - (x - x1) * sina
            xLoc = (y - y1) * sina + (x - x1) * cosa
            If Abs(yLoc) > 10 * Eps Then
                PointIntoSegmentjj = 0
                Exit Function
            End If
            If xLoc > 0 And xLoc < l Then
                PointIntoSegmentjj = 1
                Exit Function
            End If
End Function

Private Function SysLine(a1#, b1#, d1#, a2#, b2#, d2#, xRes#, yRes#) As Boolean

Dim del#, delx#, dely#
On Error GoTo ErrorHandler

    del = a1 * b2 - a2 * b1
    delx = d1 * b2 - b1 * d2
    dely = a1 * d2 - a2 * d1
    xRes = delx / del
    yRes = dely / del
    SysLine = True
    Exit Function
ErrorHandler:
'    MsgBox Err.Description
    SysLine = False
End Function

Private Function LocalBeta(sina#, cosa#, xi#, yi#, xInt#, yInt#, x#, y#) As Double
Dim Rot%
Dim xLoc#, yLoc#, xin#, yin#
Dim l#, sinb#, cosb#, beta#
    Rot = 1

    yin = Rot * ((yInt - yi) * cosa - (xInt - xi) * sina)
    xin = Rot * ((yInt - yi) * sina + (xInt - xi) * cosa)

    yLoc = Rot * ((y - yi) * cosa - (x - xi) * sina)
    xLoc = Rot * ((y - yi) * sina + (x - xi) * cosa)

    l = Sqr((xLoc - xin) * (xLoc - xin) + (yLoc - yin) * (yLoc - yin))
    If l < Eps Then
        LocalBeta = 2 * Pi
        Exit Function
    End If
    sinb = (yLoc - yin) / l
    cosb = (xLoc - xin) / l
    beta = Angle(sinb, cosb)
    If beta > Pi Then
        LocalBeta = beta - 2 * Pi
    Else
        LocalBeta = beta
    End If

End Function

Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function

Private Function PointIntoContourInter(Circuit As Graphic, xc#, yc#, xMin#, yMin#, xMax#, yMax#) As Integer
Dim Vers As Vertices, Ver As Vertex
Dim NVer As Long, nInt%, i As Long
Dim x0#, y0#, x1#, y1#
Dim a1#, b1#, d1#
Dim xInt#, yInt#

    If xc < xMin Then
        PointIntoContourInter = 0
        Exit Function
    End If
    If yc < yMin Then
        PointIntoContourInter = 0
        Exit Function
    End If
    If xc > xMax Then
        PointIntoContourInter = 0
        Exit Function
    End If
    If yc > yMax Then
        PointIntoContourInter = 0
        Exit Function
    End If

    Set Vers = Circuit.Vertices
    NVer = Vers.Count
    nInt = 0
    For i = 0 To NVer - 2
        Set Ver = Vers.Item(i)
        x0 = Ver.x
        y0 = Ver.y
        Set Ver = Vers.Item(i + 1)
        x1 = Ver.x
        y1 = Ver.y
        If Abs(xc - x0) < 0.001 And Abs(yc - y0) < 0.001 Then
            PointIntoContourInter = 1
            Exit Function
        End If
        If Abs(xc - x1) < 0.001 And Abs(yc - y1) < 0.001 Then
            PointIntoContourInter = 1
            Exit Function
        End If

        a1 = -(y1 - y0)
        b1 = x1 - x0
        d1 = a1 * x0 + b1 * y0
        ' if segment is horizontal
        If Abs(b1) > 0.001 Then
            If Abs(a1 / b1) < 0.001 Then GoTo WW1
        End If
        yInt = yc
        ' if segment is vertical
        If Abs(a1) > 0.001 Then
            If Abs(b1 / a1) < 0.001 Then
                xInt = x0
            Else
                xInt = (d1 - b1 * yInt) / a1
            End If
        End If
        If Abs(xc - xInt) < 0.001 And Abs(yc - yInt) < 0.001 Then
            PointIntoContourInter = 1
            Exit Function
        End If

        If PointIntoSegmenti(x0, y0, x1, y1, xInt, yInt) = 1 And xInt < xc Then nInt = nInt + 1
WW1:
    Next i
    If nInt = 0 Or nInt = 2 Or nInt = 4 Or nInt = 6 Or nInt = 8 Or nInt = 10 Or nInt = 12 Then
        PointIntoContourInter = 0
    Else
        PointIntoContourInter = 1
    End If
End Function

Private Function InitNew(x#, y#) As Boolean
'Dim GrSets As GraphicSets
'Dim GrSet As GraphicSet
On Error GoTo ErrHand
    Set GrSets = Dr.GraphicSets
    Set GrSet = GrSets.Add
Dim SegPrev#, SegNext#

Dim Rot% ' Initial direction of going  =1 - against clockwise  = -1 - clockwise
    Rot = 1
Dim nVRes As Long
    nVRes = 0 ' Resulting count of vertices in resulting contour
'objApp.Properties.Item("SnapMode").Value = 16
objApp.SnapModes = 0
'Vi.Refresh
Dim cosa#, sina#, xLocj#, yLocj#, xLocj1#, yLocj1#

Dim i As Long, j As Long
Dim nV As Long
Dim xMax#, xMin#, yMax#, yMin#
Dim kWork% ' Number of work contour
'Dim kWork0%
'    kWork0 = -10
Dim kWorkSel%
Dim jInit% ' Initial vertex
Dim dir%
    dir = 1
    xMax = -100000000
    xMin = 100000000
    yMax = -100000000
    yMin = 100000000
Dim xx#, yy#
Dim xi#, yi#, xi1#, yi1#
Dim k%
Dim k1% ' counter intersecting contours
Dim Dist(100) As DDD
Dim BetaMin(100) As TTT

Dim xj#, yj#, xj1#, yj1#
Dim a#, b#
Dim l#
Dim dx#, dxx#, dy#, dyy#

Dim xBeg#, yBeg#, xEnd#, yEnd#, xEnd1#, yEnd1#
Dim Pr%
Dim NewCont As Boolean 'flag - if new contour = True
    NewCont = True
    Pr = 0
    InitNew = True
' define left nearest object to  MouseClick
    dir = 1
Dim lxMin#, dxMin#, Vers As Vertices, xInt#, yInt#, xintMin#
    dxMin = 10000000
' Block to define differences world and View coordinates
'Need only for Modal space
' in Paper space - dxMod=0  dyMod=0
Dim ViH#, ViW#, xR#, yR#, ViL#, ViT#, dxMod#, dyMod#
Dim xW#, yW#, zW#, xV#, yV#, zV#
    ViH = Vi.ViewHeight
    ViW = Vi.ViewWidth
    ViL = Vi.ViewLeft
    ViT = Vi.ViewTop
 ' define world coordinates from view coordinates
    ViewToWorkPlane x, y, 0, xW, yW, zW
    dxMod = xW - x
    dyMod = yW - y
' Define difference between View and Local coordinates
Dim dxV#, dyV#
    WorkPlaneToView xW + 1#, yW, zW, xV, yV, zV
    dxV = xV - x
    dyV = yV - y
'MsgBox ("dxv=" & CStr(dxV) & "  dyv=" & CStr(dyV))
    If Abs(dyV) < 0.00001 Then
        zW = 0#
    End If
' World coordinates
    xR = x + dxMod + Sign(dyV) * zW ' if paper space dxMod,dyMod=0
    yR = y + dyMod + Sign(dxV) * zW
'Set Gr = Grs.AddSquare(xR, yR, 0)
'Vi.Refresh
'MsgBox ("zW=" & CStr(zW))
'Gr.Deleted = True
' **********************************************************************
' Define first nearest left object to mouse click
Dim x1#, y1#, st#, PResCount As Long
    st = (x - ViL) / 1000
Dim Eps1#
    Eps = 0.000001
    Eps1 = Eps
FIRST:
Dim ViLimit#
    If dxV > 0 Then
        ViLimit = ViL
    Else
        ViLimit = ViL + ViW
    End If

' Delete Brush from graphics in inital pick point
    Set PRes = Vi.PickPoint(x, y, st, True, True, True, True, True, False)
    PResCount = PRes.Count
Dim BrSt As InitBrush
ReDim BrSt.BrStyle(PResCount)
ReDim BrSt.GrID(PResCount)
Dim GrBr$
Dim BrCount As Long
    BrCount = 0
    For i = 0 To PResCount - 1
        Set Gr = PRes(i).Graphic
        GrBr = Gr.Properties("BrushStyle")
        If GrBr <> "None" Then
            BrSt.BrStyle(i) = GrBr
            BrSt.GrID(i) = Gr.ID
            Gr.Properties("BrushStyle") = ""
            BrCount = BrCount + 1
        End If
    Next i
    BrSt.nG = BrCount

' End delete

    For x1 = x - Sign(dxV) * 1 * st - Sign(dxV) * 100 * Eps To ViLimit Step -Sign(dxV) * st
        y1 = y + (x1 - x) * dyV / dxV
        Set PRes = Vi.PickPoint(x1, y1, st, True, True, True, True, True, False)
        PResCount = PRes.Count
'ViewToWorkPlane x1, y1, 0, xW, yW, zW
'Set Gr = Grs.AddCircle(xW, yW, zW)
'Vi.Refresh
'Gr.Deleted = True
'MsgBox ("x1=" & CStr(x1) & " PResCount=" & CStr(PResCount))
        If PResCount > 0 Then
'ViewToWorkPlane x1, y1, 0, xW, yW, zW
'Set Gr = Grs.AddCircle(xW, yW, zW)
'Vi.Refresh
'MsgBox ("1111PresCount=" & CStr(PResCount) & " x1=" & CStr(x1))
'Gr.Deleted = True

            Call PResToGrSet(PRes, GrSet)
            If Timer - Time0 > 30 Then
                GrSet.Clear
                InitNew = False
                Set GrSet = Nothing
                Set GrSets = Nothing
                Exit Function
            End If
            PResCount = GrSet.Count
            If PResCount = 0 Then GoTo FF1
ReDim ContSel(PResCount)
            For i = 0 To PResCount - 1
                Set Gr = GrSet.Item(i)
                If InitPicRes(Gr, ContSel(i)) = False Then
                    Exit For
                    InitNew = False
                    Exit Function
                End If
            Next i
            GrSet.Clear
            GoTo SS
        End If
FF1:
    Next x1
'    MsgBox ("Contour nonclosed")
    GrSet.Clear
    InitNew = False
    Exit Function
'***********************************************************************************
SS:
    For i = 0 To PResCount - 1
        nV = ContSel(i).NVer
        For j = 0 To nV - 2
            xj = ContSel(i).xVer(j)
            yj = ContSel(i).yVer(j)
            xj1 = ContSel(i).xVer(j + 1)
            yj1 = ContSel(i).yVer(j + 1)
            If yj > yR And yj1 > yR Then GoTo TTT
            If yj < yR And yj1 < yR Then GoTo TTT
            If Abs(yj1 - yj) > Eps Then
                xInt = xj + (xj1 - xj) / (yj1 - yj) * (yR - yj)
                If PointIntoSegmentii(xj, yj, xj1, yj1, xInt, yR) = 1 And xR - xInt > 0 Then
                    If xR - xInt < dxMin And xR - xInt > 0 Then
                        dxMin = xR - xInt
                        xintMin = xInt
'Set Gr = Grs.AddStar(xInt, yR, 0)
'Vi.Refresh
'MsgBox ("Inter")
                        jInit = j
                        kWorkSel = i
                        kWork = ContSel(i).GrInd
                    End If
                End If
            End If
TTT:
        Next j
    Next i
    If dxMin > 1000000 Then
        dxMin = 10000000
        x = x1 - st
        GoTo FIRST
    End If

Dim ContWork As ContGeo
    ContWork = ContSel(kWorkSel)
' define Dir for initial segment clockwise

    xBeg = ContWork.xVer(jInit)
    yBeg = ContWork.yVer(jInit)
    xEnd = ContWork.xVer(jInit + 1)
    yEnd = ContWork.yVer(jInit + 1)
    If yEnd > yBeg Then
        dir = 1
    Else
        dir = -1
        jInit = jInit + 1
        xBeg = ContWork.xVer(jInit)
        yBeg = ContWork.yVer(jInit)
        xEnd = ContWork.xVer(jInit + dir)
        yEnd = ContWork.yVer(jInit + dir)
    End If
'Set Gr = Grs.AddCircle(xBeg, yBeg, 0)
'Set Gr = Grs.AddCircle(xEnd, yEnd, 0)
'Vi.Refresh
'MsgBox ("xBeg=" & CStr(xBeg) & " yBeg=" & CStr(yBeg) & " xEnd=" & CStr(xEnd) & " yEnd=" & CStr(yEnd))

' Define initial point of inital segment
Dim a1#, b1#, d1#, aj#, bj#, dj#
    a1 = -(yEnd - yBeg)
    b1 = xEnd - xBeg
    d1 = a1 * xBeg + b1 * yBeg
'*********************************************************************************
'*********************************************************************************
' Selecte all Objects which are inside in circle with Radius=l/2 and Center in middle
' of the segment (xBeg,yBeg) - (xEnd,yEnd)

    l = Sqr((xEnd - xBeg) * (xEnd - xBeg) + (yEnd - yBeg) * (yEnd - yBeg))
    If l < Eps Then GoTo WWW
    dx = xintMin - xBeg
    dy = yR - yBeg
    cosa = dx / l
    sina = dy / l
    xx = (xEnd + xBeg) / 2
    yy = (yEnd + yBeg) / 2

    WorkPlaneToView xx, yy, 0, xV, yV, zV
'    Set PRes = Vi.PickPoint(xx - dxMod - Sign(dyV) * zW, yy - dyMod - Sign(dxV) * zW, 1.1 * l / 2, False, True, True, True, True, False)
    Set PRes = Vi.PickPoint(xV, yV, 1.1 * l / 2, False, True, True, True, True, False)
    PResCount = PRes.Count
    Call PResToGrSet(PRes, GrSet)
    PResCount = GrSet.Count

ReDim ContSel(PResCount)
    If PResCount > 0 Then
        For j = 0 To PResCount - 1
            Set Gr = GrSet.Item(j)
            If InitPicRes(Gr, ContSel(j)) = False Then Exit Function
        Next j
    Else
        GoTo WWW
    End If
'*********************************************************************************
    k1 = 0

    For j = 0 To PResCount - 1
        If ContSel(j).NVer = ContWork.NVer And Abs(ContSel(j).xSum - ContWork.xSum) < 100 * Eps And Abs(ContSel(j).ySum - ContWork.ySum) < 100 * Eps Then
            If Abs(ContSel(j).xVer(jInit + dir) - xEnd) < Eps And Abs(ContSel(j).yVer(jInit + dir) - yEnd) < Eps And Abs(ContSel(j).xVer(jInit) - xBeg) < Eps And Abs(ContSel(j).yVer(jInit) - yBeg) < Eps Then
                kWork = j
            End If
        End If
    Next j
   Call Projection(ContSel, PResCount)

   ContWork = ContSel(kWork)
    xBeg = ContWork.xVer(jInit)
    yBeg = ContWork.yVer(jInit)
    xEnd = ContWork.xVer(jInit + dir)
    yEnd = ContWork.yVer(jInit + dir)
    xintMin = xBeg + (xEnd - xBeg) / (yEnd - yBeg) * (yR - yBeg)
    a1 = -(yEnd - yBeg)
    b1 = xEnd - xBeg
    d1 = a1 * xBeg + b1 * yBeg
    l = Sqr((xintMin - xBeg) * (xintMin - xBeg) + (yR - yBeg) * (yR - yBeg))
    If l < Eps Then GoTo WWW
    dx = xintMin - xBeg
    dy = yR - yBeg
    cosa = dx / l
    sina = dy / l

'?????????????????????????????????????????????????????????????????????????
'????????????????????????????????????????????????????????????????????????
    For k = 0 To PResCount - 1
'       If k = kWork Then GoTo LL
        For j = 0 To ContSel(k).NVer - 2
            xj = ContSel(k).xVer(j)
            yj = ContSel(k).yVer(j)
            xj1 = ContSel(k).xVer(j + 1)
            yj1 = ContSel(k).yVer(j + 1)

'**************************************************************************
            yLocj = (yj - yBeg) * cosa - (xj - xBeg) * sina
            xLocj = (yj - yBeg) * sina + (xj - xBeg) * cosa
            yLocj1 = (yj1 - yBeg) * cosa - (xj1 - xBeg) * sina
            xLocj1 = (yj1 - yBeg) * sina + (xj1 - xBeg) * cosa
            If yLocj > Eps And yLocj1 > Eps Then GoTo LLL
            If yLocj < -Eps And yLocj1 < -Eps Then GoTo LLL
            If Abs(yLocj - yLocj1) < Eps Then GoTo LLL
            If xLocj - l > 10 * Eps And xLocj1 - l > 10 * Eps Then GoTo LLL
            If xLocj < -10 * Eps And xLocj1 < -10 * Eps Then GoTo LLL

'***********************************************************************
            aj = -(yj1 - yj)
            bj = xj1 - xj
            dj = aj * xj + bj * yj
            If Abs(aj) < Eps And Abs(bj) < Eps Then GoTo LLL
            Call SysLine(a1, b1, d1, aj, bj, dj, xInt, yInt)
            If PointIntoSegmentii(xBeg, yBeg, xintMin, yR, xInt, yInt) = 1 And PointIntoSegmentjj(xj, yj, xj1, yj1, xInt, yInt) = 1 Then
                Dist(k1).LL = Sqr((xInt - xBeg) * (xInt - xBeg) + (yInt - yBeg) * (yInt - yBeg))
                Dist(k1).xx = xInt
                Dist(k1).yy = yInt
'MsgBox ("xInt=" & CStr(xInt) & " yInt=" & CStr(yInt))
                k1 = k1 + 1

            End If
LLL:
        Next j
LL:
    Next k
Dim lMin#, l0#
Dim iMin%
Dim pr0%, pp%
    pr0 = 0
    pp = 0
    lMin = 10000000
    l0 = Sqr((xintMin - xBeg) * (xintMin - xBeg) + (yR - yBeg) * (yR - yBeg))
    For i = 0 To k1 - 1
        xInt = Dist(i).xx
        yInt = Dist(i).yy
        If PointIntoSegmenti(xBeg, yBeg, xintMin, yR, xInt, yInt) = 1 Then
            l = l0 - Dist(i).LL
            If l < lMin Then
                lMin = l
                iMin = i
                pp = 1
            End If
        End If
    Next i
    If k1 > 0 And pp = 1 Then
        xBeg = Dist(iMin).xx
        yBeg = Dist(iMin).yy
        l0 = lMin
        pr0 = 1
    End If
WWW:
'MsgBox ("xBeg=" & CStr(xBeg) & " yBeg=" & CStr(yBeg))
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Dim xCon(5000) As Double ' coordinates of resulting contour
Dim yCon(5000) As Double

' Initial point of result contour
    nVRes = 0
    xCon(nVRes) = xBeg
    yCon(nVRes) = yBeg

    For i = 0 To BrSt.nG - 1
        Set Gr = Grs.GraphicFromID(BrSt.GrID(i))
        Gr.Properties("BrushStyle") = BrSt.BrStyle(i)
    Next i
'########################################################################

'Set Gr = Grs.AddCircle(xBeg, yBeg, 0)
' Gr.Properties.Item("PenColor").Value = RGB(255, 0, 0)
'Vi.Refresh
'MsgBox ("Initial Point")
' MsgBox ("xBeg=" & CStr(xBeg) & "  yBeg=" & CStr(yBeg))
'Gr.Deleted = True
'########################################################################

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

LBEG:
    If Timer - Time0 > 30 Then
        GrSet.Clear
        InitNew = False
        Set GrSet = Nothing
        Set GrSets = Nothing
        Exit Function
    End If

    If dir = -1 And jInit = 0 Then jInit = ContWork.NVer - 1
    If dir = 1 And jInit = ContWork.NVer - 1 Then jInit = 0
'MsgBox ("LBegin jInit = " & CStr(jInit) & "  Dir = " & CStr(dir))
    If Pr = 0 Then
        xi = xBeg
        yi = yBeg
    Else
        xi = ContWork.xVer(jInit)
        yi = ContWork.yVer(jInit)
    End If
    If Pr <> 0 Then
        nVRes = nVRes + 1
        If nVRes = 3000 Then
            GrSet.Clear
            InitNew = False
            Set GrSet = Nothing
            Set GrSets = Nothing
            Exit Function
        End If
Dim x100#, y100#
    If nVRes = 100 Then
        x100 = xi
        y100 = yi
    End If
    If nVRes > 100 And Abs(x100 - xi) < Eps And Abs(y100 - yi) < Eps Then
        GrSet.Clear
        InitNew = False
        Set GrSet = Nothing
        Set GrSets = Nothing
        Exit Function
    End If

        xCon(nVRes) = xi
        yCon(nVRes) = yi
'########################################################################
' Set Gr = Grs.AddCircle(xi, yi, 0)
' Gr.Properties.Item("PenColor").Value = RGB(255, 0, 0)
' Vi.Refresh
' MsgBox ("New Point")
' MsgBox ("xi=" & CStr(xi) & "  yi=" & CStr(yi))
' Gr.Deleted = True
'########################################################################

    End If
    xi1 = ContWork.xVer(jInit + dir)
    yi1 = ContWork.yVer(jInit + dir)
    If Abs(xi - xBeg) < 10 * Eps And Abs(yi - yBeg) < 10 * Eps And Pr <> 0 Then
ReDim ContRes.xVer(nVRes + 1)
ReDim ContRes.yVer(nVRes + 1)
        ContRes.NVer = nVRes + 1
        For j = 0 To nVRes
            ContRes.xVer(j) = xCon(j)
            ContRes.yVer(j) = yCon(j)
        Next j
        GrSet.Clear
        Set GrSet = Nothing
        Set GrSets = Nothing
        Exit Function
    End If
    Pr = 1
' Defining the number of contours intersecting with curent segment
LBEG1:
'MsgBox ("xi=" & CStr(xi) & " yi=" & CStr(yi) & "  xi1=" & CStr(xi1) & " yi1=" & CStr(yi1))
    k1 = 0
    a1 = -(yi1 - yi)
    b1 = xi1 - xi
    d1 = a1 * xi + b1 * yi
    l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
    dx = (xi1 - xi)
    dy = (yi1 - yi)
    If l < Eps Then GoTo SS1
    cosa = dx / l
    sina = dy / l

' If segment belongs to new contour
    If NewCont = True Then
        NewCont = False
        GrSet.Clear
        xMax = -100000000
        xMin = 100000000
        yMax = -100000000
        yMin = 100000000
        For i = 0 To ContWork.NVer - 1
            If ContWork.xVer(i) > xMax Then xMax = ContWork.xVer(i)
            If ContWork.yVer(i) > yMax Then yMax = ContWork.yVer(i)
            If ContWork.xVer(i) < xMin Then xMin = ContWork.xVer(i)
            If ContWork.yVer(i) < yMin Then yMin = ContWork.yVer(i)
        Next i
Dim Aper#, xc#, yc#
        Aper = 1.01 * Sqr((xMax - xMin) * (xMax - xMin) + (yMax - yMin) * (yMax - yMin))
        xc = (xMax + xMin) / 2
        yc = (yMax + yMin) / 2

        WorkPlaneToView xc, yc, 0, xV, yV, zV
 '       Set PRes = Vi.PickPoint(xc - dxMod - Sign(dyV) * zW, yc - dyMod - Sign(dxV) * zW, Aper / 2, False, True, True, True, True, False)
        Set PRes = Vi.PickPoint(xV, yV, Aper / 2, False, True, True, True, True, False)
        PResCount = PRes.Count
        Call PResToGrSet(PRes, GrSet)
        PResCount = GrSet.Count
ReDim ContSel(PResCount)
        For j = 0 To PResCount - 1
            Set Gr = GrSet.Item(j)
                If InitPicRes(Gr, ContSel(j)) = False Then
                    InitNew = False
                    Exit Function
                End If
        Next j
        For j = 0 To PResCount - 1
'            If ContSel(j).NVer = ContWork.NVer And Abs(ContSel(j).xSum - ContWork.xSum) < 100 * Eps And Abs(ContSel(j).ySum - ContWork.ySum) < 100 * Eps And Abs(ContSel(j).xVer(jInit + dir) - xi1) < Eps And Abs(ContSel(j).yVer(jInit + dir) - yi1) < Eps Then
            If ContSel(j).NVer = ContWork.NVer And Abs(ContSel(j).xSum - ContWork.xSum) < 100 * Eps And Abs(ContSel(j).ySum - ContWork.ySum) < 100 * Eps Then
                If Abs(ContSel(j).xVer(jInit + dir) - xi1) < Eps And Abs(ContSel(j).yVer(jInit + dir) - yi1) < Eps Then
                    kWork = j
                End If
            End If
        Next j
        Call Projection(ContSel, PResCount)
        ContWork = ContSel(kWork)
        xi1 = ContSel(kWork).xVer(jInit + dir)
        yi1 = ContSel(kWork).yVer(jInit + dir)
        a1 = -(yi1 - yi)
        b1 = xi1 - xi
        d1 = a1 * xi + b1 * yi
        l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
        dx = (xi1 - xi)
        dy = (yi1 - yi)
        If l < Eps Then GoTo SS1
    End If

Dim EpsWorkCirc#
    If ContWork.GrType = "CIRCLE" Or ContWork.GrType = "ARC" Then
        EpsWorkCirc = ContWork.r * Pi * Pi / nVCirc / nVCirc * 1.001
    End If
    For k = 0 To PResCount - 1
Dim EpsSelCirc#
        If ContSel(k).GrType = "CIRCLE" Or ContSel(k).GrType = "ARC" Then
            EpsSelCirc = ContSel(k).r * Pi * Pi / nVCirc / nVCirc * 1.001
        End If
'MsgBox (ContSel(k).GrType)
'        If k = kWork Then GoTo L1      ??????????????????????

        For j = 0 To ContSel(k).NVer - 2
            xj = ContSel(k).xVer(j)
            yj = ContSel(k).yVer(j)
            xj1 = ContSel(k).xVer(j + 1)
            yj1 = ContSel(k).yVer(j + 1)
            If Abs(xj - xj1) < Eps And Abs(yj - yj1) < Eps Then GoTo L4

'**************************************************************************
            yLocj = (yj - yi) * cosa - (xj - xi) * sina
            xLocj = (yj - yi) * sina + (xj - xi) * cosa
            yLocj1 = (yj1 - yi) * cosa - (xj1 - xi) * sina
            xLocj1 = (yj1 - yi) * sina + (xj1 - xi) * cosa
            If k = kWork And Abs(yLocj) < Eps And Abs(yLocj1) < Eps Then GoTo L4

'MMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMMM

            If yLocj > 1 * Eps And yLocj1 > 1 * Eps Then GoTo L4
            If yLocj < -1 * Eps And yLocj1 < -1 * Eps Then GoTo L4
            If Abs(yLocj - yLocj1) < Eps And Abs(yLocj) > 100 * Eps Then GoTo L4     'And Abs(yLocj) > 10 * Eps
            If xLocj - l > 10 * Eps And xLocj1 - l > 10 * Eps Then GoTo L4
            If xLocj < -10 * Eps And xLocj1 < -10 * Eps Then GoTo L4

' If two lines are coincident
            If Abs(yLocj) < Eps And Abs(yLocj1) < Eps Then
         ' If work segment is inside other segment
                If xLocj < Eps And xLocj1 - l > 10 * Eps And k <> kWork Then

                    jInit = j
                    dir = 1
                    xi1 = xj1
                    yi1 = yj1
                    kWorkSel = k
                    ContWork = ContSel(k)
                    NewCont = True
                    GoTo LBEG1
                End If
                If xLocj1 < Eps And xLocj - l > 10 * Eps And k <> kWork Then
'MsgBox ("22222")
'MsgBox ("xi=" & CStr(xi) & " yi=" & CStr(yi) & "  xi1=" & CStr(xi1) & " yi1=" & CStr(yi1))
'MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj) & "  xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))
'MsgBox ("xLocj=" & CStr(xLocj) & " xLocj1=" & CStr(xLocj1) & "  l=" & CStr(l))
                    jInit = j + 1
                    dir = -1
                    xi1 = xj
                    yi1 = yj
                    kWorkSel = k
                    ContWork = ContSel(k)
                    NewCont = True
                    GoTo LBEG1
                End If

        ' If Work segment and other segment coincident in ended points
                If Abs(xLocj - l) < Eps And xLocj1 - l > 10 * Eps Then
                    Dist(k1).LL = l
                    Dist(k1).xx = xi1
                    Dist(k1).yy = yi1
                    Dist(k1).jj = j
                    Dist(k1).jj1 = j + 1
                    Dist(k1).kk = k
                    k1 = k1 + 1 'Set Gr = Grs.AddCross(xint, yint, 0)
                    GoTo L4
                End If
                If Abs(xLocj1 - l) < Eps And xLocj - l > 10 * Eps Then
                    Dist(k1).LL = l
                    Dist(k1).xx = xi1
                    Dist(k1).yy = yi1
                    Dist(k1).jj = j
                    Dist(k1).jj1 = j + 1
                    Dist(k1).kk = k
                    k1 = k1 + 1 'Set Gr = Grs.AddCross(xint, yint, 0)
                    GoTo L4
                End If

            End If

            If Abs(yLocj) < Eps And Abs(yLocj1) < Eps Then GoTo L4

'***********************************************************************
'MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj) & "  xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))
            aj = -(yj1 - yj)
            bj = xj1 - xj
            dj = aj * xj + bj * yj
            Call SysLine(a1, b1, d1, aj, bj, dj, xInt, yInt)
'MsgBox ("xInt=" & CStr(xint) & " yInt=" & CStr(yint))
            If Abs(xInt - xi) < Eps And Abs(yInt - yi) < Eps Then GoTo L4
            If PointIntoSegmentii(xi, yi, xi1, yi1, xInt, yInt) = 1 And PointIntoSegmentjj(xj, yj, xj1, yj1, xInt, yInt) = 1 Then
                If ContWork.GrType = "CIRCLE" And k <> kWork Then
                    SegNext = xj + yj + xj1 + yj1
                    If Abs((SegNext - SegPrev) / SegNext) < 0.01 Then
                        SegPrev = 0
                        GoTo L4
                    End If
                End If
                Dist(k1).LL = Sqr((xInt - xi) * (xInt - xi) + (yInt - yi) * (yInt - yi))
                Dist(k1).xx = xInt
                Dist(k1).yy = yInt
                Dist(k1).jj = j
                Dist(k1).jj1 = j + 1
                Dist(k1).kk = k
                k1 = k1 + 1

'Set Gr = Grs.AddCross(xInt, yInt, 0)
'Vi.Refresh
'MsgBox ("Point intersection k1=" & CStr(k1))
'MsgBox ("xInt=" & CStr(xInt) & " yInt=" & CStr(yInt))
'MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj) & "  xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))
'Gr.Deleted = True
            End If
L4:
        Next j
L1:
    Next k
SS1:
Dim alfaj#, alfai#

Dim jj%, kk%, pr1%, pr2%, prr%
    pr1 = 0
    pr2 = 0
    prr = 0

'MsgBox (" Finish k1 = " & CStr(k1))
'MsgBox ("Dir Rot = " & CStr(Rot))
    If k1 = 1 And Dist(0).kk = kWork And Abs(ContWork.xVer(jInit + dir) - Dist(0).xx) < Eps And Abs(ContWork.yVer(jInit + dir) - Dist(0).yy) < Eps Then k1 = 0

    If k1 = 0 Then
'checking intersection contour- kWork with other contouts in point - i+1
Dim xii#, yii#
Dim yLoc#, xLoc#
Dim jj1%
Dim xxi1#, yyi1#
Dim alfaj1#

        If dir = 1 And jInit = ContWork.NVer - 1 Then
            If ContWork.Closed = True Then jInit = 0
        End If
        If dir = -1 And jInit = 0 Then
            If ContWork.Closed = True Then jInit = ContWork.NVer - 1
        End If

        jInit = jInit + dir
        If dir = 1 And jInit = ContWork.NVer - 1 Then
                If ContWork.Closed = True Then jInit = 0
        End If
        If dir = -1 And jInit = 0 Then
            If ContWork.Closed = True Then jInit = ContWork.NVer - 1
        End If
        If dir = 1 And jInit = ContWork.NVer - 1 Then
            If ContWork.Closed = False Then
                dir = -1
'                MsgBox ("Created contour is not closed")
'                Exit Function
            End If
        End If
        If dir = -1 And jInit = 0 Then
            If ContWork.Closed = False Then
                dir = 1
'                MsgBox ("Created contour is not closed")
'                Exit Function
            End If
        End If
        SegPrev = 0
        GoTo LBEG
    End If   ' k1=0

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

' if k1>0 There are same intersections current segment witt other graphics
'MsgBox (">>>>>>k1=" & CStr(k1))
Dim kmin%
    lMin = 10000000
    For k = 0 To k1 - 1
        If lMin > Dist(k).LL Then
            lMin = Dist(k).LL
            kmin = k
        End If
    Next k
Dim k2%, Mi(100) As Long
    k2 = 0
' Define number graphics intersecting with current segment at nearest point
    For k = 0 To k1 - 1
        If Abs(Dist(k).LL - lMin) < Eps Then
            Mi(k2) = k
            k2 = k2 + 1
        End If
    Next k
'MsgBox ("k2=" & CStr(k2) & "  dir=" & CStr(dir) & " jInit=" & CStr(jInit))

    l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
    cosa = (xi1 - xi) / l
    sina = (yi1 - yi) / l

If ContWork.GrType <> "CIRCLE" Then
  SegPrev = ContWork.xVer(jInit) + ContWork.yVer(jInit) + ContWork.xVer(jInit + dir) + ContWork.yVer(jInit + dir)
End If

Dim j1%

 ' There are intersections current segment with oter graphics
 Dim xinter#, yinter#, beta1#, beta2#, xj_1#, yj_1#
    For k = 0 To k2 - 1
        xinter = Dist(Mi(k)).xx
        yinter = Dist(Mi(k)).yy
        j = Dist(Mi(k)).jj
        k1 = Dist(Mi(k)).kk
        xj = ContSel(k1).xVer(j)
        yj = ContSel(k1).yVer(j)
        xj1 = ContSel(k1).xVer(j + 1)
        yj1 = ContSel(k1).yVer(j + 1)
        ' If point of intersection concidences with vertex - j
        If Abs(xinter - xj) < Eps And Abs(yinter - yj) < Eps Then
'MsgBox ("xinter - xj) < Eps" & "   j=" & CStr(j))
'MsgBox ("xj1=" & CStr(xj1) & "  yj1=" & CStr(yj1))
            If j = 0 Then
                If ContSel(k1).Closed = False Then
                    beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj1, yj1)
                    BetaMin(k).Bet = beta1
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j
                    BetaMin(k).ddir = 1
                Else
                    beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj1, yj1)
                    xj_1 = ContSel(k1).xVer(ContSel(k1).NVer - 2)
                    yj_1 = ContSel(k1).yVer(ContSel(k1).NVer - 2)
                    beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                    BetaMin(k).Bet = beta1
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j
                    BetaMin(k).ddir = 1
                End If
            Else
                beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj1, yj1)
                xj_1 = ContSel(k1).xVer(j - 1)
                yj_1 = ContSel(k1).yVer(j - 1)
                beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                If beta1 > beta2 Then
                    BetaMin(k).Bet = beta2
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j
                    BetaMin(k).ddir = -1
                Else
                    BetaMin(k).Bet = beta1
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j
                    BetaMin(k).ddir = 1
                End If
            End If
            GoTo GGG
        End If
        ' If point of intersection concidences with vertex - j+1
        If Abs(xinter - xj1) < Eps And Abs(yinter - yj1) < Eps Then
'MsgBox (" inter = xj1" & " j+1=" & CStr(j + 1) & "  k1=" & CStr(k1) & "  Cont(k1).NVer - 1=" & CStr(Cont(k1).NVer - 1))
            If j + 1 = ContSel(k1).NVer - 1 Then
                If ContSel(k1).Closed = False Then
                    beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
                    BetaMin(k).Bet = beta1
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j + 1
                    BetaMin(k).ddir = -1
                Else
                    beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
                    xj_1 = ContSel(k1).xVer(1)
                    yj_1 = ContSel(k1).yVer(1)
                    beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                    If beta1 > beta2 Then
                        BetaMin(k).Bet = beta2
                        BetaMin(k).kk = k1
                        BetaMin(k).jInit = 0
                        BetaMin(k).ddir = 1
                    Else
                        BetaMin(k).Bet = beta1
                        BetaMin(k).kk = k1
                        BetaMin(k).jInit = j + 1
                        BetaMin(k).ddir = -1
                    End If
                End If
            Else
                beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
                xj_1 = ContSel(k1).xVer(j + 2)
                yj_1 = ContSel(k1).yVer(j + 2)
                beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                BetaMin(k).Bet = beta1
                BetaMin(k).kk = k1
                BetaMin(k).jInit = j + 1
                BetaMin(k).ddir = -1
'                        End If
            End If
            GoTo GGG
        End If
'MsgBox (" Point is Internal")
        ' If point of intersection is internal point of segment j - j+1
        beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
        beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj1, yj1)
'MsgBox ("xinter=" & CStr(xinter) & "  yinter=" & CStr(yinter))
'MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj))
'MsgBox ("xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))
'MsgBox ("Beta1=" & CStr(beta1 * 180 / Pi) & "  Beta2=" & CStr(beta2 * 180 / Pi))
        If beta1 > beta2 Then
            BetaMin(k).Bet = beta2
            BetaMin(k).kk = k1
            BetaMin(k).jInit = j
            BetaMin(k).ddir = 1
        Else
            BetaMin(k).Bet = beta1
            BetaMin(k).kk = k1
            BetaMin(k).jInit = j + 1
            BetaMin(k).ddir = -1
        End If
GGG:
'MsgBox (" k=" & CStr(k) & "  LocBet=" & CStr(BetaMin(k).Bet * 180 / Pi))
        ' Conditions for current graphic -kWork
Dim BetaWork#
        If Abs(xinter - xi1) < Eps And Abs(yinter - yi1) < Eps Then
'MsgBox ("End point" & " dir=" & CStr(dir) & " jInit + dir=" & CStr(jInit + dir))
            If ContWork.Closed = False And dir > 0 And jInit + dir = ContWork.NVer - 1 Then
                BetaMin(k2).Bet = 2 * Pi
                BetaWork = 2 * Pi
                GoTo UU1
            End If
            If ContWork.Closed = False And dir < 0 And jInit + dir = 0 Then
                BetaMin(k2).Bet = 2 * Pi
                BetaWork = 2 * Pi
                GoTo UU1
            End If
            If ContWork.Closed = True And dir > 0 And jInit + dir = ContWork.NVer - 1 Then
                xj = ContWork.xVer(1)
                yj = ContWork.yVer(1)
                BetaMin(k2).jInit = 0
                GoTo UUU
            End If
            If ContWork.Closed = True And dir < 0 And jInit + dir = 0 Then
                xj = ContWork.xVer(ContWork.NVer - 2)
                yj = ContWork.yVer(ContWork.NVer - 2)
                BetaMin(k2).jInit = ContWork.NVer - 1
                GoTo UUU
            End If
            xj = ContWork.xVer(jInit + 2 * dir)
            yj = ContWork.yVer(jInit + 2 * dir)
            BetaMin(k2).jInit = jInit + dir

UUU:
            beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
            BetaMin(k2).Bet = beta1
            BetaWork = beta1
            BetaMin(k2).kk = -100
            BetaMin(k2).ddir = dir
UU1:
        Else
            BetaMin(k2).Bet = 0
            BetaWork = 0
            BetaMin(k2).jInit = jInit
            BetaMin(k2).kk = -100
            BetaMin(k2).ddir = dir
        End If
    Next k

Dim BeMin#
    BeMin = 2 * Pi
    For k = 0 To k2
        If BetaMin(k).Bet < BeMin And Abs(BetaMin(k).Bet + Pi) > 0.01 And Abs(BetaMin(k).Bet + 2 * Pi) > 0.01 Then
            kmin = k
            BeMin = BetaMin(k).Bet
        End If
    Next k
'MsgBox ("BeMin=" & CStr(BeMin * 180 / Pi) & " BetaMin(kmin).kk=" & CStr(BetaMin(kmin).kk))

    xi = xinter
    yi = yinter
    If BetaMin(kmin).kk <> -100 Then  'And Abs(BeMin - BetaWork) > 0.001
        xi1 = ContSel(BetaMin(kmin).kk).xVer(BetaMin(kmin).jInit + BetaMin(kmin).ddir)
        yi1 = ContSel(BetaMin(kmin).kk).yVer(BetaMin(kmin).jInit + BetaMin(kmin).ddir)
        jInit = BetaMin(kmin).jInit
        dir = BetaMin(kmin).ddir
    Else
        xi1 = ContWork.xVer(BetaMin(kmin).jInit + BetaMin(kmin).ddir)
        yi1 = ContWork.yVer(BetaMin(kmin).jInit + BetaMin(kmin).ddir)
        jInit = BetaMin(kmin).jInit
        dir = BetaMin(kmin).ddir
    End If
    nVRes = nVRes + 1
    If nVRes = 2000 Then
        GrSet.Clear
        InitNew = False
        Set GrSet = Nothing
        Set GrSets = Nothing
        Exit Function
    End If
    If nVRes = 100 Then
        x100 = xi
        y100 = yi
    End If
    xCon(nVRes) = xi
    yCon(nVRes) = yi
    If nVRes > 100 And Abs(x100 - xi) < Eps And Abs(y100 - yi) < Eps Then
        GrSet.Clear
        InitNew = False
        Set GrSet = Nothing
        Set GrSets = Nothing
        Exit Function
    End If

'###########################################################################
'Set Gr = Grs.AddStar(xi, yi, 0)
' Gr.Properties.Item("PenColor").Value = RGB(255, 0, 0)
' Vi.Refresh
' MsgBox (" Point Intersection")
' MsgBox ("xi=" & CStr(xi) & "  yi=" & CStr(yi))
' Gr.Deleted = True
'###########################################################################
    If EpsWorkCirc > Eps1 Then
        Eps1 = EpsWorkCirc
    End If
    If EpsSelCirc > Eps1 Then
        Eps1 = EpsSelCirc
    End If
    If Abs(xi - xBeg) < Eps1 And Abs(yi - yBeg) < Eps1 Then
ReDim ContRes.xVer(nVRes + 1)
ReDim ContRes.yVer(nVRes + 1)
        ContRes.NVer = nVRes + 1
        For j = 0 To nVRes
            ContRes.xVer(j) = xCon(j)
            ContRes.yVer(j) = yCon(j)
        Next j
        ContRes.xVer(0) = ContRes.xVer(nVRes)
        ContRes.yVer(0) = ContRes.yVer(nVRes)
            GrSet.Clear
            Set GrSet = Nothing
            Set GrSets = Nothing

        Exit Function
    End If
'MsgBox ("WWWWWWWWWW BetaMin(kmin).kk=" & CStr(BetaMin(kmin).kk))
    If BetaMin(kmin).kk <> -100 Then
        kWork = ContSel(BetaMin(kmin).kk).GrInd
        kWorkSel = BetaMin(kmin).kk
        ContWork = ContSel(BetaMin(kmin).kk)
'MsgBox ("ContWork.NVerNew=" & CStr(ContWork.NVer))
'MsgBox ("xi1=" & CStr(xi1) & " yi1=" & CStr(yi1))
        NewCont = True
    End If

    GoTo LBEG1

    Exit Function

ErrHand:
'    MsgBox Err.Description
    InitNew = False
    GrSet.Clear
    Set GrSet = Nothing
    Set GrSets = Nothing

End Function

Private Function InitPicRes(Gr As Graphic, Con As ContGeo) As Boolean
Dim Vers As Vertices, Ver As Vertex
Dim nV As Long, i As Long
Dim GrID As Long
On Error GoTo ErrHand
'MsgBox ("begin")
    InitPicRes = True
Dim GrType As String
Dim GrDup As Graphic
    GrType = Gr.Type
'    Con.GrInd = Gr.Index
    If GrType = "CIRCLE" Then
        If Circl(Gr, Con) = True Then
            Exit Function
        Else
            InitPicRes = False
            Exit Function
        End If
    End If
    If GrType = "TCW30CURVE" Then
        If Curve(Gr, Con) = True Then
            Exit Function
        Else
            InitPicRes = False
            Exit Function
        End If
    End If
    If GrType = "GRAPHIC" Then
        If Grap(Gr, Con) = True Then
            Exit Function
        Else
            InitPicRes = False
            Exit Function
        End If
    End If
    If GrType = "TCW50Polyline" Then
        If MultiL(Gr, Con) = True Then
            Exit Function
        Else
            InitPicRes = False
            Exit Function
        End If
    End If

    If GrType = "ARC" Then
        If Arc(Gr, Con) = True Then
            Exit Function
        Else
            InitPicRes = False
            Exit Function
        End If
    End If
    ' For flexible text
    If GrType = "TEXT" Then
        If Gr.Properties.Item("TextMode").Value = 3 Then
            If TextFlex(Gr, Con) = True Then
                Exit Function
            Else
                InitPicRes = False
                Exit Function
            End If
        End If
   End If

    Exit Function
ErrHand:
'    MsgBox Err.Description
    InitPicRes = False
End Function

' This function works with graphic - Curve and write coordinates it's child' vertices
' into structure Con, return - if object is closed else - False

Private Function TextFlex(GrSel As Graphic, Con As ContGeo) As Boolean
Dim nV As Long, i As Long
Dim Ver As Vertex, Vers As Vertices
Dim BBox As BoundingBox
'        Set BBox = GrSel.CalcBoundingBox
'        Set Ver = BBox.Max
'        Con.xyMax(0) = Ver.x
'        Con.xyMax(1) = Ver.y
'        Set Ver = BBox.Min
'        Con.xyMin(0) = Ver.x
'        Con.xyMin(1) = Ver.y

        TextFlex = True
        Set Vers = GrSel.Graphics.Item(0).Vertices
        nV = Vers.Count
        Con.NVer = nV
ReDim Con.xVer(nV)
ReDim Con.yVer(nV)
        Con.xSum = 0
        Con.ySum = 0
Dim xMax#, yMax#, xMin#, yMin#
        xMax = -10000000
        yMax = -10000000
        xMin = 10000000
        yMin = 10000000

        For i = 0 To nV - 1
            Set Ver = Vers.Item(i)
            Con.xVer(i) = Ver.x
            Con.yVer(i) = Ver.y
            If Con.xVer(i) > xMax Then xMax = Con.xVer(i)
            If Con.yVer(i) > yMax Then yMax = Con.yVer(i)
            If Con.xVer(i) < xMin Then xMin = Con.xVer(i)
            If Con.yVer(i) < yMin Then yMin = Con.yVer(i)
            Con.xSum = Con.xSum + Con.xVer(i)
            Con.ySum = Con.ySum + Con.yVer(i)
        Next i
        If Abs(Con.xVer(0) - Con.xVer(nV - 1)) < Eps And Abs(Con.yVer(0) - Con.yVer(nV - 1)) < Eps Then
            Con.Closed = True
        Else
            Con.Closed = False
        End If
        Con.GrType = "TEXT"
        Con.xyMax(0) = xMax
        Con.xyMax(1) = yMax
        Con.xyMin(0) = xMin
        Con.xyMin(1) = yMin

        Set Ver = Nothing
        Set BBox = Nothing
End Function

' This function works with graphic - Curve and write coordinates it's child' vertices
' into structure Con, return - if object is closed else - False

Private Function Curve(GrSel As Graphic, Con As ContGeo) As Boolean
Dim nV As Long, i As Long
Dim Ver As Vertex, Vers As Vertices
Dim BBox As BoundingBox
'        Set BBox = GrSel.CalcBoundingBox
'        Set Ver = BBox.Max
'        Con.xyMax(0) = Ver.x
'        Con.xyMax(1) = Ver.y
'        Set Ver = BBox.Min
'        Con.xyMin(0) = Ver.x
'        Con.xyMin(1) = Ver.y

        Curve = True
        For i = 0 To GrSel.Graphics.Count - 1
            If GrSel.Graphics(i).Type = "GRAPHIC" Then
                Set Vers = GrSel.Graphics.Item(i).Vertices
                Exit For
            End If
        Next i
'        Set Vers = GrSel.Graphics.Item(1).Vertices
        nV = Vers.Count
        Con.NVer = nV
ReDim Con.xVer(nV)
ReDim Con.yVer(nV)
        Con.xSum = 0
        Con.ySum = 0
Dim xMax#, yMax#, xMin#, yMin#
        xMax = -10000000
        yMax = -10000000
        xMin = 10000000
        yMin = 10000000

        For i = 0 To nV - 1
            Set Ver = Vers.Item(i)
            Con.xVer(i) = Ver.x
            Con.yVer(i) = Ver.y
            If Con.xVer(i) > xMax Then xMax = Con.xVer(i)
            If Con.yVer(i) > yMax Then yMax = Con.yVer(i)
            If Con.xVer(i) < xMin Then xMin = Con.xVer(i)
            If Con.yVer(i) < yMin Then yMin = Con.yVer(i)

            Con.xSum = Con.xSum + Con.xVer(i)
            Con.ySum = Con.ySum + Con.yVer(i)
        Next i
        If Abs(Con.xVer(0) - Con.xVer(nV - 1)) < Eps And Abs(Con.yVer(0) - Con.yVer(nV - 1)) < Eps Then
            Con.Closed = True
        Else
            Con.Closed = False
        End If
        Con.GrType = "TCW30CURVE"
        Con.xyMax(0) = xMax
        Con.xyMax(1) = yMax
        Con.xyMin(0) = xMin
        Con.xyMin(1) = yMin

        Set Ver = Nothing
        Set BBox = Nothing
End Function

' This function works with graphic - Circle and write coordinates it's child' vertices
' into structure Con, return - if object is closed else - False

Private Function Circl(GrSel As Graphic, Con As ContGeo) As Boolean
Dim nV As Long, i As Long
Dim Ver As Vertex
Dim xc#, yc#, ArcData(10) As Double
Dim xMax#, yMax#, a#, b#, sina#, cosa#, x#, y#, fi#, Alp#, tet#, r#
Dim xMin#, yMin#
Dim BBox As BoundingBox
'        Set BBox = GrSel.CalcBoundingBox
'        Set Ver = BBox.Max
'        Con.xyMax(0) = Ver.x
'        Con.xyMax(1) = Ver.y
'        Set Ver = BBox.Min
'        Con.xyMin(0) = Ver.x
'        Con.xyMin(1) = Ver.y

            Circl = True
            GrSel.GetArcData ArcData
            xc = ArcData(0)
            yc = ArcData(1)
            GrSel.Vertices.UseWorldCS = False
            xc = GrSel.Vertices(0).x
            yc = GrSel.Vertices(0).y
            xMax = ArcData(3)
            yMax = ArcData(4)
            a = Sqr((xMax - xc) * (xMax - xc) + (yMax - yc) * (yMax - yc))
            b = a * ArcData(6)
            sina = (yMax - yc) / a
            cosa = (xMax - xc) / a
            Alp = Angle(sina, cosa)
            nV = nVCirc
            Con.NVer = nV
ReDim Con.xVer(nV)
ReDim Con.yVer(nV)
            Con.xSum = 0
            Con.ySum = 0
            xMax = -100000000
            yMax = -100000000
            xMin = 100000000
            yMin = 100000000

            For i = 0 To nV - 1
                fi = i * 2 * Pi / (nV - 1)
                x = a * Cos(fi)
                y = b * Sin(fi)
                If a <> b Then
                    r = Sqr(x * x + y * y)
                    sina = y / r
                    cosa = x / r
                    tet = Angle(sina, cosa)
                    tet = tet + Alp
                    x = r * Cos(tet)
                    y = r * Sin(tet)
                End If
                If xc + x > xMax Then xMax = xc + x
                If yc + y > yMax Then yMax = yc + y
                If xc + x < xMin Then xMin = xc + x
                If yc + y < yMin Then yMin = yc + y
                Con.xVer(i) = xc + x
                Con.yVer(i) = yc + y
                Con.xSum = Con.xSum + Con.xVer(i)
                Con.ySum = Con.ySum + Con.yVer(i)
            Next i
            Con.xyMax(0) = xMax
            Con.xyMax(1) = yMax
            Con.xyMin(0) = xMin
            Con.xyMin(1) = yMin

            Con.xVer(nV - 1) = Con.xVer(0)
            Con.yVer(nV - 1) = Con.yVer(0)

            Con.Closed = True
            Con.GrType = "CIRCLE"
            Con.r = a
            Con.xc = xc
            Con.yc = yc
            Set BBox = Nothing

End Function

' This function works with graphic - Graphic and write coordinates it's child' vertices
' into structure Con, return - if object is closed else - False

Private Function Grap(GrSel As Graphic, Con As ContGeo) As Boolean
Dim nV As Long, i As Long
Dim Ver As Vertex, Vers As Vertices
Dim BBox As BoundingBox
'        Set BBox = GrSel.CalcBoundingBox
'        Set Ver = BBox.Max
'        Con.xyMax(0) = Ver.x
'        Con.xyMax(1) = Ver.y
'        Set Ver = BBox.Min
'        Con.xyMin(0) = Ver.x
'        Con.xyMin(1) = Ver.y

        Grap = True
            Set Vers = GrSel.Vertices
            nV = Vers.Count
            Con.NVer = nV
ReDim Con.xVer(nV)
ReDim Con.yVer(nV)
        Con.xSum = 0
        Con.ySum = 0
Dim xMax#, yMax#, xMin#, yMin#
            xMax = -10000000
            yMax = -10000000
            xMin = 10000000
            yMin = 10000000
            For i = 0 To nV - 1
                Set Ver = Vers.Item(i)
                Con.xVer(i) = Ver.x
                Con.yVer(i) = Ver.y
                If Con.xVer(i) > xMax Then xMax = Con.xVer(i)
                If Con.yVer(i) > yMax Then yMax = Con.yVer(i)
                If Con.xVer(i) < xMin Then xMin = Con.xVer(i)
                If Con.yVer(i) < yMin Then yMin = Con.yVer(i)
                Con.xSum = Con.xSum + Con.xVer(i)
                Con.ySum = Con.ySum + Con.yVer(i)
            Next i
            If Abs(Con.xVer(0) - Con.xVer(nV - 1)) < Eps And Abs(Con.yVer(0) - Con.yVer(nV - 1)) < Eps Then
                Con.Closed = True
            Else
                Con.Closed = False
            End If
            Con.GrType = "GRAPHIC"
            Con.xyMax(0) = xMax
            Con.xyMax(1) = yMax
            Con.xyMin(0) = xMin
            Con.xyMin(1) = yMin

        Set Ver = Nothing
        Set BBox = Nothing
End Function

' This function works with MultiLine and write coordinates it's child' vertices
' into structure Con, return - if object is closed else - False

Private Function MultiL(GrSel As Graphic, Con As ContGeo) As Boolean
Dim nV As Long, i As Long
Dim Ver As Vertex, Vers As Vertices
Dim BBox As BoundingBox
'        Set BBox = GrSel.CalcBoundingBox
'        Set Ver = BBox.Max
'        Con.xyMax(0) = Ver.x
'        Con.xyMax(1) = Ver.y
'        Set Ver = BBox.Min
'        Con.xyMin(0) = Ver.x
'        Con.xyMin(1) = Ver.y

        MultiL = True
        For i = 0 To GrSel.Graphics.Count - 1
            If GrSel.Graphics(i).Type = "GRAPHIC" Then
                Set Vers = GrSel.Graphics.Item(i).Vertices
                Exit For
            End If
        Next i
'        Set Vers = GrSel.Graphics.Item(0).Vertices
        nV = Vers.Count
        Con.NVer = nV
ReDim Con.xVer(nV)
ReDim Con.yVer(nV)
        Con.xSum = 0
        Con.ySum = 0
Dim xMax#, yMax#, xMin#, yMin#
        xMax = -10000000
        yMax = -10000000
        xMin = 10000000
        yMin = 10000000
        For i = 0 To nV - 1
            Set Ver = Vers.Item(i)
            Con.xVer(i) = Ver.x
            Con.yVer(i) = Ver.y
            If Con.xVer(i) > xMax Then xMax = Con.xVer(i)
            If Con.yVer(i) > yMax Then yMax = Con.yVer(i)
            If Con.xVer(i) < xMin Then xMin = Con.xVer(i)
            If Con.yVer(i) < yMin Then yMin = Con.yVer(i)
            Con.xSum = Con.xSum + Con.xVer(i)
            Con.ySum = Con.ySum + Con.yVer(i)
        Next i
        If Abs(Con.xVer(0) - Con.xVer(nV - 1)) < Eps And Abs(Con.yVer(0) - Con.yVer(nV - 1)) < Eps Then
            Con.Closed = True
        Else
            Con.Closed = False
        End If
        Con.GrType = "TCW50Polyline"
        Con.xyMax(0) = xMax
        Con.xyMax(1) = yMax
        Con.xyMin(0) = xMin
        Con.xyMin(1) = yMin

        Set Ver = Nothing
        Set BBox = Nothing
End Function

' This function works with NonClosed DoubleLine and write coordinates it's child' vertices
' into structure Con, return - if object is closed else - False

Private Function DblNon(GrSel As Graphic, Con As ContGeo) As Boolean
Dim nV As Long, i As Long
Dim Ver As Vertex, Vers As Vertices
Dim BBox As BoundingBox
'        Set BBox = GrSel.CalcBoundingBox
'        Set Ver = BBox.Max
'        Con.xyMax(0) = Ver.x
'        Con.xyMax(1) = Ver.y
'        Set Ver = BBox.Min
'        Con.xyMin(0) = Ver.x
'        Con.xyMin(1) = Ver.y

        DblNon = True
        Set Vers = GrSel.Graphics.Item(1).Vertices
        nV = Vers.Count
        Con.NVer = nV
ReDim Con.xVer(nV)
ReDim Con.yVer(nV)
        Con.xSum = 0
        Con.ySum = 0
Dim xMax#, yMax#, xMin#, yMin#
        xMax = -10000000
        yMax = -10000000
        xMin = 10000000
        yMin = 10000000
        For i = 0 To nV - 1
            Set Ver = Vers.Item(i)
            Con.xVer(i) = Ver.x
            Con.yVer(i) = Ver.y
            If Con.xVer(i) > xMax Then xMax = Con.xVer(i)
            If Con.yVer(i) > yMax Then yMax = Con.yVer(i)
            If Con.xVer(i) < xMin Then xMin = Con.xVer(i)
            If Con.yVer(i) < yMin Then yMin = Con.yVer(i)
            Con.xSum = Con.xSum + Con.xVer(i)
            Con.ySum = Con.ySum + Con.yVer(i)
        Next i
        Con.Closed = True
        Con.xyMax(0) = xMax
        Con.xyMax(1) = yMax
        Con.xyMin(0) = xMin
        Con.xyMin(1) = yMin
        Set Ver = Nothing
        Set BBox = Nothing
End Function
Private Function ArcExpl(GrSel As Graphic, Con As ContGeo) As Boolean
Dim nV As Long, i As Long
Dim Ver As Vertex
Dim GrDup As Graphic
Dim GrSe As GraphicSet
Dim Vers As Vertices
Dim GrDupIndex  As Long
Dim ArcData(10) As Double, xc#, yc#, xMax#, yMax#, a#
            GrSel.GetArcData ArcData
            xc = ArcData(0)
            yc = ArcData(1)
            xMax = ArcData(3)
            yMax = ArcData(4)
            a = Sqr((xMax - xc) * (xMax - xc) + (yMax - yc) * (yMax - yc))

            Set GrDup = GrSel.Duplicate
            GrDupIndex = GrDup.Index
            Grs.Remove (GrDupIndex)
            Set GrSe = GrDup.Explode
            Set Gr = GrSe.Item(0)
            GrDup.Delete
            Set Vers = Gr.Vertices
            nV = Vers.Count
            Con.NVer = nV
ReDim Con.xVer(nV)
ReDim Con.yVer(nV)
        Con.xSum = 0
        Con.ySum = 0
        For i = 0 To nV - 1
            Set Ver = Vers.Item(i)
            Con.xVer(i) = Ver.x
            Con.yVer(i) = Ver.y
            Con.xSum = Con.xSum + Con.xVer(i)
            Con.ySum = Con.ySum + Con.yVer(i)
        Next i
            Con.Closed = False
            Con.GrType = "CIRCLE"
            Con.r = a
            Con.xc = xc
            Con.yc = yc

            Set Ver = Nothing
            Set Vers = Nothing
            Set GrDup = Nothing
            Set GrSe = Nothing
            ArcExpl = True
End Function

' This function works with graphic - Circle and write coordinates it's child' vertices
' into structure Con, return - if object is closed else - False

Private Function Arc(GrSel As Graphic, Con As ContGeo) As Boolean
Dim nV As Long, i As Long
Dim Ver As Vertex
Dim xc#, yc#, ArcData(10) As Double
Dim xMax#, yMax#, a#, b#, sina#, cosa#, x#, y#, fi#, Alp#, tet#, r#
Dim xMin#, yMin#
Dim fiBeg#, fiEnd#, dfi#
Dim BBox As BoundingBox
'        Set BBox = GrSel.CalcBoundingBox
'        Set Ver = BBox.Max
'        Con.xyMax(0) = Ver.x
'        Con.xyMax(1) = Ver.y
'        Set Ver = BBox.Min
'        Con.xyMin(0) = Ver.x
'        Con.xyMin(1) = Ver.y

            Arc = True
            GrSel.GetArcData ArcData
            xc = ArcData(0)
            yc = ArcData(1)
            xMax = ArcData(3)
            yMax = ArcData(4)
            fiBeg = ArcData(7)
            fiEnd = ArcData(8)
            If fiBeg > fiEnd Then fiBeg = fiBeg - 2 * Pi
            a = Sqr((xMax - xc) * (xMax - xc) + (yMax - yc) * (yMax - yc))
            b = a * ArcData(6)
            sina = (yMax - yc) / a
            cosa = (xMax - xc) / a
            Alp = Angle(sina, cosa)

            nV = Int(Abs(fiEnd - fiBeg) / (2 * Pi) * nVCirc)  '* 121)
            If nV = 0 Then nV = 1
            dfi = (fiEnd - fiBeg) / nV

            Con.NVer = nV + 1
ReDim Con.xVer(nV)
ReDim Con.yVer(nV)
            xMax = -100000000
            yMax = -100000000
            xMin = 100000000
            yMin = 100000000

            For i = 0 To nV
                fi = fiBeg + i * dfi + Alp
                x = a * Cos(fi)
                y = b * Sin(fi)
                If a <> b Then
                    r = Sqr(x * x + y * y)
                    sina = y / r
                    cosa = x / r
                    tet = Angle(sina, cosa)
                    tet = tet + Alp
                    x = r * Cos(tet)
                    y = r * Sin(tet)
                End If
                Con.xVer(i) = xc + x
                Con.xSum = Con.xSum + Con.xVer(i)
                Con.yVer(i) = yc + y
                Con.ySum = Con.ySum + Con.yVer(i)
                If xc + x > xMax Then xMax = xc + x
                If yc + y > yMax Then yMax = yc + y
                If xc + x < xMin Then xMin = xc + x
                If yc + y < yMin Then yMin = yc + y
'Set Gr = Grs.AddStar(Con.xVer(i), Con.yVer(i), 0)
'Vi.Refresh
'MsgBox ("fi=" & CStr(fi * 180 / Pi))
            Next i
            If Abs(a - b) < Eps Then
                Con.xVer(0) = GrSel.Vertices.Item(1).x
               Con.yVer(0) = GrSel.Vertices.Item(1).y
                Con.xVer(nV) = GrSel.Vertices.Item(2).x
                Con.yVer(nV) = GrSel.Vertices.Item(2).y
            End If

            If Abs(Con.xVer(0) - Con.xVer(nV)) < Eps And Abs(Con.yVer(0) - Con.yVer(nV)) < Eps Then
                Con.Closed = True
            Else
                Con.Closed = False
            End If
            Con.xyMax(0) = xMax
            Con.xyMax(1) = yMax
            Con.xyMin(0) = xMin
            Con.xyMin(1) = yMin
            Con.GrType = "CIRCLE"
            Con.r = a
            Con.xc = xc
            Con.yc = yc
        Set Ver = Nothing
        Set BBox = Nothing

End Function

Private Function PResToGrSet(PRe As PickResult, GrSet As GraphicSet) As Boolean
    PResToGrSet = True
'
'On Error GoTo ErrHand
Dim PResCount As Long, i As Long, j As Long, k As Long
Dim Pen As PickEntry
Dim GrPick As Graphic
Dim GrType As String
Dim GroupCount As Long
Dim GrDup As Graphic
Dim GrSe As GraphicSet
Dim GrDupIndex As Long
Dim nV As Long
Dim GrE As Graphic
Dim Ver As Vertex
Dim Vers As Vertices
Dim VerE As Vertex
Dim VerNext As Vertex
Dim nGDbl As Long
Dim hGrPick As Long
Dim hMatPick As Long

    PResCount = PRe.Count
    For i = 0 To PResCount - 1
        Set Pen = PRe.Item(i)
        Set GrPick = Pen.Graphic
        hGrPick = TCWGraphicAt(hDr, GrPick.Index)
        hMatPick = GraphicGetMatrix(hGrPick)
        If MatrixEqual(hMWorkPlane, hMatPick) = False Then GoTo L1

        GrType = GrPick.Type
        If GrType = "TCW30POINT" Then GoTo L1
        If GrType = "TCW25DimLin" Then GoTo L1
        If GrType = "TCW25DimDat" Then GoTo L1
        If GrType = "TCW25DimAng" Then GoTo L1
        If GrType = "TCW25DimRad" Then GoTo L1
        If GrType = "TCW25DimDia" Then GoTo L1
        If GrType = "TCW25DimLead" Then GoTo L1
        If GrType = "TC_Multiline" Then GoTo L1

        If GrType = "TCW40CUBE" Then GoTo L1
        If GrType = "TCW40SPHERE" Then GoTo L1
        If GrType = "TCW40LOFT" Then GoTo L1
        If GrType = "TCW40EXTRUDE" Then GoTo L1
        If GrType = "TCW40SPIN" Then GoTo L1
        If GrType = "TCW60ACISSOLID" Then GoTo L1
        If GrType = "SURFACE" Then GoTo L1

        If GrType = "INSERT" Then GoTo L1

   '     If GrType = "TCW60Wall" Then GoTo L1
        On Error Resume Next
Dim LayerName As String
'        LayerName = "    "
'        LayerName = GrPick.Layer.Name
'        If LayerName = "$CONSTRUCTION" Then GoTo L1
        If GrPick.Unbounded = True Then GoTo L1

Dim BrushStyle As String
        BrushStyle = "    "

'        If GrType = "INSERT" Then GoTo GGG
'        If GrType = "GRAPHIC" And GrPick.Graphics.Count > 0 Then GoTo GGG
'        If GrType <> "INSERT" Then
'            BrushStyle = GrPick.Properties.Item("BrushStyle").Value
'            If BrushStyle <> "None" Then GoTo L1
'        End If
'GGG:

        If GrType = "TCW70Region" Then
            GroupCount = GrPick.Graphics.Count
            Set Gr = GrPick.Graphics.Item(GroupCount - 1)
            Call ExplodeWithUnVisible(Gr, GrSet)
            GoTo L1
        End If

        GroupCount = GrPick.Graphics.Count
        If GroupCount = 0 Then
            If Space = 1 Then
                If GrPick.Properties("Thickness") <> 0 Then GoTo L1
            End If
        End If
        If GrType = "GRAPHIC" Then
            If GroupCount = 0 Then
                Call ExplodeWithUnVisible(GrPick, GrSet)
            Else
                If GrPick.Graphics.Count = 1 And GrPick.Graphics(0).Type = "DATA" Then
                    GrSet.AddGraphic GrPick
                    GoTo L1
                End If
                For j = 0 To GroupCount - 1
                    Set Gr = GrPick.Graphics.Item(j)
                    GrSet.AddGraphic Gr
                Next j
            End If
            GoTo L1
        End If

'*********************************************************************************
        If GrType = "TCW50IntProp" Then ' If Graphic - HATCH
            If GrPick.Graphics.Item(0).Properties.Item("Info").Value = "Brush_Cosmetic" Then
                Set Vers = GrPick.Vertices
                nV = Vers.Count
                Set GrE = GrSet.Add(11)
                For j = 0 To nV - 1
                    Set Ver = GrE.Vertices.Add(Vers.Item(j).x, Vers.Item(j).y, 0)
                    Ver.PenDown = True
                Next j
                Set Ver = Nothing
                Set Vers = Nothing
                Set GrE = Nothing
'                Set Vers = GrPick.Vertices
'                nV = Vers.Count
'                Set GrE = GrSet.Add(11)
'                For k = 0 To nV - 2
'                    Set Ver = Vers.Item(k)
'                    Set VerNext = Vers.Item(k + 1)
'                    If VerNext.PenDown = True Then
'                        Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
'                    Else
'                        If Ver.PenDown = True Then
'                            Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
'                        End If
'                        If k + 1 < nV - 1 Then
'                            Set GrE = GrSet.Add(11)
'                        End If
'                    End If
'                Next k
'                Set Ver = Vers.Item(nV - 1)
'                If Ver.PenDown = True Then
'                    Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
'                End If
'Set VerNext = Nothing
'Set Ver = Nothing
'Set VerE = Nothing
'Set Vers = Nothing
'Set GrE = Nothing

                GoTo L1
            End If
            If GrPick.Graphics.Item(0).Properties.Item("Info").Value = "Line_Width_Cosmetic" Then
                If GrPick.Closed = False Then
                    Set Vers = GrPick.Graphics.Item(0).Vertices
                    nV = Vers.Count
                    Set GrE = GrSet.Add(11)
                    For j = 0 To nV - 1
                        Set Ver = GrE.Vertices.Add(Vers.Item(j).x, Vers.Item(j).y, 0)
                        Ver.PenDown = True
                    Next j
                Else
                    Set Vers = GrPick.Graphics.Item(0).Vertices
                    nV = Vers.Count
                    Set GrE = GrSet.Add(11)
                    Set Ver = Vers.Item(1)
                    Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                    For k = 2 To nV - 2
                        Set Ver = Vers.Item(k)
                        If Ver.PenDown = True Then
                            Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                            VerE.PenDown = True
                        Else
                            If Vers.Item(k + 1).PenDown = True And k + 1 <> nV - 1 Then
                                Set GrE = GrSet.Add(11)
                                Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                                VerE.PenDown = True
                            End If
                        End If
                    Next k
                    Set Ver = Vers.Item(nV - 1)
                    Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                End If
                Set Ver = Nothing
                Set VerE = Nothing
                Set Vers = Nothing
                Set GrE = Nothing
                GoTo L1
            End If
        End If
'**************************************************************************

'**************************************************************************
        If GrType = "INSERT" Then

            Set GrDup = GrPick.Duplicate
            GrDupIndex = GrDup.Index
            Grs.Remove (GrDupIndex)
            Set GrSe = GrDup.Explode
            GroupCount = GrSe.Count
            For j = 0 To GroupCount - 1
                GrSet.AddGraphic GrSe.Item(j)
            Next j
            GrDup.Delete
            Set GrDup = Nothing
            Set GrSe = Nothing
            GoTo L1
        End If
'*********************************************************************************
'**************************************************************************
        If GrType = "TCW25DblLine" Or GrType = "TCW60Wall" Then

            nGDbl = GrPick.Graphics.Count
'GoTo WWW
'                Set Gr = GrPick.Graphics.Item(nGDbl - 1)
'                nV = Gr.Vertices.Count
'                Set GrE = GrSet.Add(11)
'                Set Vers = Gr.Vertices
'                Set Ver = Vers.Item(0)
'                Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
'                For k = 1 To nV - 2
'                    Set Ver = Vers.Item(k)
'                    If Ver.PenDown = True Then
'                        Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
'                    Else
'                        If Vers.Item(k + 1).PenDown = True And k + 1 <> nV - 1 Then
'                            Set GrE = GrSet.Add(11)
'                            Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
'                        End If
'                    End If
'                Next k
'Set Ver = Nothing
'Set VerE = Nothing
'Set Vers = Nothing
'Set GrE = Nothing
'WWW:
            For k = 0 To nGDbl - 1
                With GrPick.Graphics(k)
                    If .Type = "GRAPHIC" Then
                        If .Vertices.Count > 2 And .Properties("Info") <> "Gap" Then
                            Call ExplodeWithUnVisible(GrPick.Graphics(k), GrSet)
                        End If
                    End If
                End With
            Next k
            GoTo L1
        End If
' If GraphicType -CIRCLE ---------------------------------------------------------------
        If GrType = "CIRCLE" Then
'MsgBox (GrPick.Graphics.Item(0).Properties.Item("Info").Value)
            If GrPick.Graphics.Count = 0 Then
                GrSet.AddGraphic GrPick
                GoTo L1
            Else
                If GrPick.Graphics.Count = 1 And GrPick.Graphics(0).Type = "GRAPHIC" And GrPick.Properties("BrushStyle") <> "None" And GrPick.Properties("BrushStyle") <> "Solid" Then
                    GrSet.AddGraphic GrPick
                    GoTo L1
                End If

                If GrPick.Graphics.Count = 1 And GrPick.Graphics(0).Type = "DATA" Then
                    GrSet.AddGraphic GrPick
                    GoTo L1
                End If
                If GrPick.Graphics.Item(0).Properties.Item("Info").Value = "Line_Width_Cosmetic" Then
                    Set Vers = GrPick.Graphics.Item(0).Vertices
                    nV = Vers.Count
'MsgBox ("nV=" & CStr(nV))
                    Set GrE = GrSet.Add(11)
                    Set Ver = Vers.Item(1)
                    Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                    For k = 2 To nV - 2
                        Set Ver = Vers.Item(k)
                        If Ver.PenDown = True Then
                            Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                            VerE.PenDown = True
                        Else
                            If Vers.Item(k + 1).PenDown = True And k + 1 <> nV - 1 Then
                                Set GrE = GrSet.Add(11)
                                Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                                VerE.PenDown = True
                            End If
                        End If
                    Next k
                    Set Ver = Vers.Item(nV - 1)
                    Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                    VerE.PenDown = True
                    Set Ver = Nothing
                    Set VerE = Nothing
                    Set Vers = Nothing
                    Set GrE = Nothing
                    GoTo L1
                End If
            End If
        End If
' ----------------------------------------------------------------------------------------
        If GrType = "ARC" Then
            If GrPick.Graphics.Count = 0 Then
                GrSet.AddGraphic GrPick
                GoTo L1
            Else
                If GrPick.Graphics.Count = 1 And GrPick.Graphics(0).Type = "DATA" Then
                    GrSet.AddGraphic GrPick
                    GoTo L1
                End If
                If GrPick.Graphics.Item(0).Properties.Item("Info").Value = "Line_Width_Cosmetic" Then
                    Set Vers = GrPick.Graphics.Item(0).Vertices
                    nV = Vers.Count
                    If GrPick.Closed = False Then
                        Set GrE = GrSet.Add(11)
                        For j = 0 To nV - 1
                            Set Ver = GrE.Vertices.Add(Vers.Item(j).x, Vers.Item(j).y, 0)
                            Ver.PenDown = True
                        Next j
                        Set Ver = Nothing
                        Set VerE = Nothing
                        Set Vers = Nothing
                        Set GrE = Nothing
                        GoTo L1
                    End If
                End If
            End If
        End If
        If GrType = "TCW30CURVE" Or GrType = "TCW50Polyline" Then
            If GrPick.Graphics.Item(1).Graphics.Item(0).Properties.Item("Info").Value <> "Line_Width_Cosmetic" Then
                GrSet.AddGraphic GrPick
                GoTo L1
            Else
                If GrPick.Closed = False Then
                    Set Vers = GrPick.Graphics.Item(1).Graphics.Item(0).Vertices
                    nV = Vers.Count
                    Set GrE = GrSet.Add(11)
                    For j = 0 To nV - 1
                        Set Ver = GrE.Vertices.Add(Vers.Item(j).x, Vers.Item(j).y, 0)
                        Ver.PenDown = True
                    Next j
                Else
                    Set Vers = GrPick.Graphics.Item(1).Graphics.Item(0).Vertices
                    nV = Vers.Count
                    Set GrE = GrSet.Add(11)
                    Set Ver = Vers.Item(1)
                    Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                    For k = 2 To nV - 2
                        Set Ver = Vers.Item(k)
                        If Ver.PenDown = True Then
                            Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                            VerE.PenDown = True
                        Else
                            If Vers.Item(k + 1).PenDown = True And k + 1 <> nV - 1 Then
                                Set GrE = GrSet.Add(11)
                                Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                                VerE.PenDown = True
                            End If
                        End If
                    Next k
                    Set Ver = Vers.Item(nV - 1)
                    Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                End If
                Set Ver = Nothing
                Set VerE = Nothing
                Set Vers = Nothing
                Set GrE = Nothing
                GoTo L1
            End If
        End If

        If GrType = "TEXT" Then
            If GrPick.Properties.Item("TextMode").Value <> 3 Then
                GoTo L1
            Else
                If GrPick.Graphics.Count > 1 Then GoTo L1
'                GrSet.AddGraphic GrPick.Graphics.Item(0)
'                GoTo L1
                Set Gr = GrPick.Graphics.Item(0)
                nV = Gr.Vertices.Count
                Set GrE = GrSet.Add(11)
                Set Vers = Gr.Vertices
                Set Ver = Vers.Item(0)
                Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                For k = 1 To nV - 2
                    Set Ver = Vers.Item(k)
'                    Set VerNext = Vers.Item(k + 1)
                    If Ver.PenDown = True Then
                        Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                    Else
                        If Vers.Item(k + 1).PenDown = True And k + 1 <> nV - 1 Then
                            Set GrE = GrSet.Add(11)
                            Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                        End If
                    End If
                Next k
                Set Ver = Vers.Item(nV - 1)
                If Ver.PenDown = True Then
                    Set VerE = GrE.Vertices.Add(Ver.x, Ver.y, 0)
                End If

Set Ver = Nothing
Set VerE = Nothing
Set Vers = Nothing
Set GrE = Nothing

            GoTo L1

            End If
        End If
      ' If single graphic
L1:
    Next i
    Set Ver = Nothing
    Set Vers = Nothing

    Exit Function
ErrHand:
'    MsgBox ("Error PRGrSet")
'    MsgBox Err.Description
    PResToGrSet = False
End Function

' Function return 1 - if point lies inside line segment, or 0 - if point lies outside or on
' on bounds of line segment

Private Function PointIntoSegmenti(x1#, y1#, x2#, y2#, x#, y#) As Integer

Dim dx#, dy#, l#, sina#, cosa#
            PointIntoSegmenti = 0
            If Abs(x - x1) < Eps And Abs(y - y1) < Eps Then
                PointIntoSegmenti = 0
                Exit Function
            End If
            If Abs(x - x2) < Eps And Abs(y - y2) < Eps Then
                PointIntoSegmenti = 1
                Exit Function
            End If
Dim xLoc#, yLoc#
            dx = x2 - x1
            dy = y2 - y1
            l = Sqr(dx * dx + dy * dy)
            If l < Eps Then Exit Function
            sina = dy / l
            cosa = dx / l

            yLoc = (y - y1) * cosa - (x - x1) * sina
            xLoc = (y - y1) * sina + (x - x1) * cosa
            If Abs(yLoc) > 10 * Eps Then
                PointIntoSegmenti = 0
                Exit Function
            End If
            If xLoc > 0 And xLoc < l Then
                PointIntoSegmenti = 1
                Exit Function
            End If

End Function

Private Function PointIntoSegmentj(x1#, y1#, x2#, y2#, x#, y#) As Integer

Dim dx#, dy#, l#, sina#, cosa#
            PointIntoSegmentj = 0
            If Abs(x - x1) < Eps And Abs(y - y1) < Eps Then
                PointIntoSegmentj = 0
                Exit Function
            End If
            If Abs(x - x2) < Eps And Abs(y - y2) < Eps Then
                PointIntoSegmentj = 1
                Exit Function
            End If
Dim xLoc#, yLoc#
            dx = x2 - x1
            dy = y2 - y1
            l = Sqr(dx * dx + dy * dy)
            If l < Eps Then Exit Function
            sina = dy / l
            cosa = dx / l

            yLoc = (y - y1) * cosa - (x - x1) * sina
            xLoc = (y - y1) * sina + (x - x1) * cosa
            If Abs(yLoc) > 10 * Eps Then
                PointIntoSegmentj = 0
                Exit Function
            End If
            If xLoc > 0 And xLoc < l Then
                PointIntoSegmentj = 1
                Exit Function
            End If

End Function

Private Function InitSSS(Con() As ContGeo, nG As Long, x#, y#, CRes As ContGeo) As Boolean
On Error GoTo ErrHand

Dim Rot% ' Initial direction of going  =1 - against clockwise  = -1 - clockwise
    Rot = 1
Dim nVRes As Long
    nVRes = 0 ' Resulting count of
Dim i As Long, j As Long
Dim nV As Long
Dim xMax#, xMin#, yMax#, yMin#
Dim kWork% ' Number of work contour
Dim jInit% ' Initial vertex
Dim dir%
    dir = 1
    xMax = -100000000
    xMin = 100000000
    yMax = -100000000
    yMin = 100000000
Dim xx#, yy#
Dim xi#, yi#, xi1#, yi1#
Dim k%
Dim k1% ' counter intersecting contours
Dim Dist(100) As DDD
Dim BetaMin(100) As TTT

Dim xj#, yj#, xj1#, yj1#
Dim a#, b#
Dim l#
Dim dx#, dxx#, dy#, dyy#

Dim xBeg#, yBeg#, xEnd#, yEnd#, xEnd1#, yEnd1#
Dim Pr%
Dim NewCont As Boolean
    NewCont = True
    Pr = 0
    InitSSS = True
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' define left nearest object to  MouseClick
    dir = 1
Dim lxMin#, dxMin#, xInt#, yInt#, xintMin#
    dxMin = 10000000

    For i = 0 To nG
        If Con(i).TakePart = True Then GoTo TTT1
        If Con(i).xyMin(1) - y > 10 * Eps Then GoTo TTT1
        If Con(i).xyMax(1) - y < -10 * Eps Then GoTo TTT1
        nV = Con(i).NVer
        For j = 0 To nV - 2
            xj = Con(i).xVer(j)
            yj = Con(i).yVer(j)
            xj1 = Con(i).xVer(j + 1)
            yj1 = Con(i).yVer(j + 1)
            If yj - y > Eps And yj1 - y > Eps Then GoTo TTT
            If yj - y < -Eps And yj1 - y < -Eps Then GoTo TTT
            If Abs(yj1 - yj) > Eps Then
                xInt = xj + (xj1 - xj) / (yj1 - yj) * (y - yj)
                If PointIntoSegmentii(xj, yj, xj1, yj1, xInt, y) = 1 And x - xInt > 0 Then
                    If x - xInt < dxMin Then
                        dxMin = x - xInt
                        xintMin = xInt
                        jInit = j
                        kWork = i
                    End If
                End If
            End If
TTT:
        Next j
TTT1:
    Next i

Dim ContWork As ContGeo
    ContWork = Con(kWork)
' define Dir for initial segment clockwise

    xBeg = ContWork.xVer(jInit)
    yBeg = ContWork.yVer(jInit)
    xEnd = ContWork.xVer(jInit + 1)
    yEnd = ContWork.yVer(jInit + 1)
    If yEnd > yBeg Then
        dir = 1
    Else
        dir = -1
        jInit = jInit + 1
        xBeg = ContWork.xVer(jInit)
        yBeg = ContWork.yVer(jInit)
        xEnd = ContWork.xVer(jInit + dir)
        yEnd = ContWork.yVer(jInit + dir)
    End If
'MsgBox ("SSSSxBeg=" & CStr(xBeg) & " yBeg=" & CStr(yBeg) & " xEnd=" & CStr(xEnd) & " yEnd=" & CStr(yEnd))

' Define initial point of inital segment
Dim a1#, b1#, d1#, aj#, bj#, dj#
Dim dl#
    a1 = -(yEnd - yBeg)
    b1 = xEnd - xBeg
    d1 = a1 * xBeg + b1 * yBeg
'*********************************************************************************
'*********************************************************************************
' Selecte all Objects which are inside in circle with Radius=l/2 and Center in middle
' of the segment (xBeg,yBeg) - (xIntMin,y)

    l = Sqr((xintMin - xBeg) * (xintMin - xBeg) + (y - yBeg) * (y - yBeg))
    If l < Eps Then GoTo WWW
    dx = xintMin - xBeg
    dy = y - yBeg
    xx = (xintMin + xBeg) / 2
    yy = (y + yBeg) / 2

'*********************************************************************************
'*********************************************************************************
Dim cosa#, sina#, xLocj#, yLocj#, xLocj1#, yLocj1#
    cosa = dx / l
    sina = dy / l
    k1 = 0
    For k = 0 To nG
        If Con(i).TakePart = True Then GoTo LL
        If Con(i).xyMin(1) - yEnd > 10 * Eps Then GoTo LL
        If Con(i).xyMax(1) - yBeg < -10 * Eps Then GoTo LL
        If xEnd > xBeg Then
            If Con(i).xyMin(0) - xEnd > 10 * Eps Then GoTo LL
            If Con(i).xyMax(0) - xBeg < -10 * Eps Then GoTo LL
        End If
        If xEnd < xBeg Then
            If Con(i).xyMin(0) - xBeg > 10 * Eps Then GoTo LL
            If Con(i).xyMax(0) - xEnd < -10 * Eps Then GoTo LL
        End If

'        If ContSel(k).GrInd = kWork Then GoTo LL
        For j = 0 To Con(k).NVer - 2
            xj = Con(k).xVer(j)
            yj = Con(k).yVer(j)
            xj1 = Con(k).xVer(j + 1)
            yj1 = Con(k).yVer(j + 1)
'**************************************************************************
            yLocj = (yj - yBeg) * cosa - (xj - xBeg) * sina
            xLocj = (yj - yBeg) * sina + (xj - xBeg) * cosa
            yLocj1 = (yj1 - yBeg) * cosa - (xj1 - xBeg) * sina
            xLocj1 = (yj1 - yBeg) * sina + (xj1 - xBeg) * cosa
            If yLocj > Eps And yLocj1 > Eps Then GoTo LLL
            If yLocj < -Eps And yLocj1 < -Eps Then GoTo LLL
            If Abs(yLocj - yLocj1) < Eps Then GoTo LLL
            If xLocj - l > Eps And xLocj1 - l > Eps Then GoTo LLL
            If xLocj < -Eps And xLocj1 < -Eps Then GoTo LLL

'***********************************************************************
            aj = -(yj1 - yj)
            bj = xj1 - xj
            dj = aj * xj + bj * yj
            Call SysLine(a1, b1, d1, aj, bj, dj, xInt, yInt)
            If PointIntoSegmentii(xBeg, yBeg, xintMin, y, xInt, yInt) = 1 And PointIntoSegmentjj(xj, yj, xj1, yj1, xInt, yInt) = 1 Then
                Dist(k1).LL = Sqr((xInt - xBeg) * (xInt - xBeg) + (yInt - yBeg) * (yInt - yBeg))
                Dist(k1).xx = xInt
                Dist(k1).yy = yInt
                k1 = k1 + 1

            End If
LLL:
        Next j
LL:
    Next k
Dim lMin#, l0#
Dim iMin%
Dim pr0%, pp%
    pr0 = 0
    pp = 0
    lMin = 10000000
    l0 = Sqr((xintMin - xBeg) * (xintMin - xBeg) + (y - yBeg) * (y - yBeg))
    For i = 0 To k1 - 1
        xInt = Dist(i).xx
        yInt = Dist(i).yy
        If PointIntoSegmenti(xBeg, yBeg, xintMin, y, xInt, yInt) = 1 Then
            l = l0 - Dist(i).LL
            If l < lMin Then
                lMin = l
                iMin = i
                pp = 1
            End If
        End If
    Next i
    If k1 > 0 And pp = 1 Then
        xBeg = Dist(iMin).xx
        yBeg = Dist(iMin).yy
        l0 = lMin
        pr0 = 1
    End If
WWW:
'MsgBox ("xBeg=" & CStr(xBeg) & " yBeg=" & CStr(yBeg))
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Dim xCon(10000) As Double
Dim yCon(10000) As Double

' Initial point of result contour
    nVRes = 0
    xCon(nVRes) = xBeg
    yCon(nVRes) = yBeg

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'Set Gr = Grs.AddCircle(xBeg, yBeg, 0)
'Gr.Properties.Item("PenColor").Value = RGB(0, 255, 0)
'Vi.Refresh
'MsgBox ("Initial Point")
'Gr.Deleted = True
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
LBEG:
    If dir = -1 And jInit = 0 Then jInit = ContWork.NVer - 1
    If dir = 1 And jInit = ContWork.NVer - 1 Then jInit = 0
'MsgBox ("LBegin jInit = " & CStr(jInit) & "  Dir = " & CStr(dir))
    If Pr = 0 Then
        xi = xBeg
        yi = yBeg
    Else
        xi = ContWork.xVer(jInit)
        yi = ContWork.yVer(jInit)
    End If
    If Pr <> 0 Then
        nVRes = nVRes + 1
        If nVRes = 9000 Then
            InitSSS = False
            Exit Function
        End If
        xCon(nVRes) = xi
        yCon(nVRes) = yi
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
' Set Gr = Grs.AddCircle(xi, yi, 0)
'Gr.Properties.Item("PenColor").Value = RGB(0, 255, 0)
' Vi.Refresh
' MsgBox ("New Point")
' Gr.Deleted = True
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
    End If
    xi1 = ContWork.xVer(jInit + dir)
    yi1 = ContWork.yVer(jInit + dir)
    If Abs(xi - xBeg) < Eps And Abs(yi - yBeg) < Eps And Pr <> 0 Then
ReDim CRes.xVer(nVRes + 1)
ReDim CRes.yVer(nVRes + 1)
        CRes.NVer = nVRes + 1
        For j = 0 To nVRes
            CRes.xVer(j) = xCon(j)
            CRes.yVer(j) = yCon(j)
        Next j
        Exit Function
    End If
    Pr = 1
' Defining the number of contours intersecting with curent segment
LBEG1:
'MsgBox ("xi=" & CStr(xi) & " yi=" & CStr(yi) & "  xi1=" & CStr(xi1) & " yi1=" & CStr(yi1))
    k1 = 0
    a1 = -(yi1 - yi)
    b1 = xi1 - xi
    d1 = a1 * xi + b1 * yi

    l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
    dx = (xi1 - xi)
    dy = (yi1 - yi)
    If l < Eps Then
        k1 = 0
        GoTo SS1
    End If

    cosa = dx / l
    sina = dy / l
'MsgBox ("xi=" & CStr(xi) & " yi=" & CStr(yi) & "  xi1=" & CStr(xi1) & " yi1=" & CStr(yi1))
        xMin = ContWork.xyMin(0)
        yMin = ContWork.xyMin(1)
        xMax = ContWork.xyMax(0)
        yMax = ContWork.xyMax(1)

    For k = 0 To nG
'        If k = kWork Then GoTo L1      ??????????????????????
        If k <> kWork Then
            If Con(k).xyMin(0) - xMax > 10 * Eps Then GoTo L1
            If Con(k).xyMin(1) - yMax > 10 * Eps Then GoTo L1

            If Con(k).xyMax(0) - xMin < -10 * Eps Then GoTo L1
            If Con(k).xyMax(1) - yMin < -10 * Eps Then GoTo L1
        End If
        For j = 0 To Con(k).NVer - 2
            xj = Con(k).xVer(j)
            yj = Con(k).yVer(j)
            xj1 = Con(k).xVer(j + 1)
            yj1 = Con(k).yVer(j + 1)
'MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj) & "  xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))

            If Abs(xj - xj1) < Eps And Abs(yj - yj1) < Eps Then GoTo L4

'**************************************************************************
            yLocj = (yj - yi) * cosa - (xj - xi) * sina
            xLocj = (yj - yi) * sina + (xj - xi) * cosa
            yLocj1 = (yj1 - yi) * cosa - (xj1 - xi) * sina
            xLocj1 = (yj1 - yi) * sina + (xj1 - xi) * cosa
            If k = kWork And Abs(yLocj) < Eps And Abs(yLocj1) < Eps Then GoTo L4

            If yLocj > 10 * Eps And yLocj1 > 10 * Eps Then GoTo L4
            If yLocj < -10 * Eps And yLocj1 < -10 * Eps Then GoTo L4
            If Abs(yLocj - yLocj1) < Eps And Abs(yLocj) > Eps Then GoTo L4
            If xLocj - l > 10 * Eps And xLocj1 - l > 10 * Eps Then GoTo L4
            If xLocj < -10 * Eps And xLocj1 < -10 * Eps Then GoTo L4
'***********************************************************************
'MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj) & "  xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))

' If two lines are coincident
            If Abs(yLocj) < Eps And Abs(yLocj1) < Eps Then
          ' if work segment is inside oter segment
                If xLocj < Eps And xLocj1 - l > 10 * Eps And k <> kWork Then
                    jInit = j
                    dir = 1
                    xi1 = xj1
                    yj1 = yj1
                    kWork = k
                    ContWork = Con(k)
                    NewCont = True
                    GoTo LBEG1
                End If
                If xLocj1 < Eps And xLocj - l > 10 * Eps And k <> kWork Then
                    jInit = j + 1
                    dir = -1
                    xi1 = xj
                    yi1 = yj
                    kWork = k
                    ContWork = Con(k)
                    NewCont = True
                    GoTo LBEG1
                End If
            ' If Work segment and other segment coincident in Ended points
                If Abs(xLocj - l) < Eps And xLocj1 - l > 10 * Eps And k <> kWork Then
'MsgBox ("111111111")
                    Dist(k1).LL = l
                    Dist(k1).xx = xi1
                    Dist(k1).yy = yi1
                    Dist(k1).jj = j
                    Dist(k1).jj1 = j + 1
                    Dist(k1).kk = k
                    k1 = k1 + 1 'Set Gr = Grs.AddCross(xint, yint, 0)
                    GoTo L4
                End If
                If Abs(xLocj1 - l) < Eps And xLocj - l > 10 * Eps And k <> kWork Then

                   Dist(k1).LL = l
                    Dist(k1).xx = xi1
                    Dist(k1).yy = yi1
                    Dist(k1).jj = j
                    Dist(k1).jj1 = j + 1
                    Dist(k1).kk = k
                    k1 = k1 + 1 'Set Gr = Grs.AddCross(xint, yint, 0)
'MsgBox ("22222222" & " j=" & CStr(j))
' MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj) & "  xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))
'MsgBox ("xi1=" & CStr(xi1) & " yi1=" & CStr(yi1) & " k1=" & CStr(k1))

                    GoTo L4
                End If
            End If
            If Abs(yLocj) < Eps And Abs(yLocj1) < Eps Then GoTo L4

'MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj) & "  xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))
            aj = -(yj1 - yj)
            bj = xj1 - xj
            dj = aj * xj + bj * yj
            Call SysLine(a1, b1, d1, aj, bj, dj, xInt, yInt)
'MsgBox ("xInt=" & CStr(xInt) & " yInt=" & CStr(yInt))
'Set Gr = Grs.AddCross(xInt, yInt, 0)
'Vi.Refresh
'MsgBox ("Point intersection k1=" & CStr(k1))
'MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj) & "  xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))
'MsgBox ("xInt=" & CStr(xInt) & " yInt=" & CStr(yInt))

            If Abs(xInt - xi) < Eps And Abs(yInt - yi) < Eps Then GoTo L4
            If PointIntoSegmentii(xi, yi, xi1, yi1, xInt, yInt) = 1 And PointIntoSegmentjj(xj, yj, xj1, yj1, xInt, yInt) = 1 Then
                Dist(k1).LL = Sqr((xInt - xi) * (xInt - xi) + (yInt - yi) * (yInt - yi))
                Dist(k1).xx = xInt
                Dist(k1).yy = yInt
                Dist(k1).jj = j
                Dist(k1).jj1 = j + 1
                Dist(k1).kk = k
                k1 = k1 + 1 'Set Gr = Grs.AddCross(xint, yint, 0)
'Set Gr = Grs.AddCross(xInt, yInt, 0)
'Vi.Refresh
'MsgBox ("Point intersection k1=" & CStr(k1))
'MsgBox ("xj=" & CStr(xj) & " yj=" & CStr(yj) & "  xj1=" & CStr(xj1) & " yj1=" & CStr(yj1))
'MsgBox ("xInt=" & CStr(xInt) & " yInt=" & CStr(yInt))

            End If
L4:
        Next j
L1:
    Next k
SS1:
Dim alfaj#, alfai#

Dim jj%, kk%, pr1%, pr2%, prr%
    pr1 = 0
    pr2 = 0
    prr = 0

'MsgBox (" Finish k1 = " & CStr(k1))
'MsgBox ("Dir Rot = " & CStr(Rot))
 '   If k1 = 1 And Dist(0).kk = kWork And Abs(ContWork.xVer(jInit + dir) - Dist(0).xx) < Eps And Abs(ContWork.yVer(jInit + dir) - Dist(0).yy) < Eps Then k1 = 0
    If k1 = 0 Then
'checking intersection contour- kWork with other contouts in point - i+1
Dim xii#, yii#
Dim yLoc#, xLoc#
Dim jj1%
Dim xxi1#, yyi1#
Dim alfaj1#

        If dir = 1 And jInit = ContWork.NVer - 1 Then
            If ContWork.Closed = True Then jInit = 0
        End If
        If dir = -1 And jInit = 0 Then
            If ContWork.Closed = True Then jInit = ContWork.NVer - 1
        End If

        jInit = jInit + dir
        If dir = 1 And jInit = ContWork.NVer - 1 Then
                If ContWork.Closed = True Then jInit = 0
        End If
        If dir = -1 And jInit = 0 Then
            If ContWork.Closed = True Then jInit = ContWork.NVer - 1
        End If
        If dir = 1 And jInit = ContWork.NVer - 1 Then
            If ContWork.Closed = False Then
                dir = -1
'                MsgBox ("Created contour is not closed")
'                Exit Function
            End If
        End If
        If dir = -1 And jInit = 0 Then
            If ContWork.Closed = False Then
                dir = 1
'                MsgBox ("Created contour is not closed")
'                Exit Function
            End If
        End If
        GoTo LBEG
    End If   ' k1=0

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

' if k1>0 There are same intersections current segment witt other graphics
'MsgBox (">>>>>>k1=" & CStr(k1))
Dim kmin%
    lMin = 10000000
    For k = 0 To k1 - 1
        If lMin > Dist(k).LL Then
            lMin = Dist(k).LL
            kmin = k
        End If
    Next k
Dim k2%, Mi(100) As Long
    k2 = 0
' Define number graphics intersecting with current segment at nearest point
    For k = 0 To k1 - 1
        If Abs(Dist(k).LL - lMin) < Eps Then
            Mi(k2) = k
            k2 = k2 + 1
        End If
    Next k
'MsgBox ("k2=" & CStr(k2) & "  dir=" & CStr(dir) & " jInit=" & CStr(jInit))

    l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
    cosa = (xi1 - xi) / l
    sina = (yi1 - yi) / l

Dim j1%

 ' There are intersections current segment with oter graphics
 Dim xinter#, yinter#, beta1#, beta2#, xj_1#, yj_1#
    For k = 0 To k2 - 1
        xinter = Dist(Mi(k)).xx
        yinter = Dist(Mi(k)).yy
        j = Dist(Mi(k)).jj
        k1 = Dist(Mi(k)).kk
        xj = Con(k1).xVer(j)
        yj = Con(k1).yVer(j)
        xj1 = Con(k1).xVer(j + 1)
        yj1 = Con(k1).yVer(j + 1)
        ' If point of intersection concidences with vertex - j
        If Abs(xinter - xj) < Eps And Abs(yinter - yj) < Eps Then
            If j = 0 Then
                If Con(k1).Closed = False Then
                    beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj1, yj1)
'MsgBox ("Beta1=" & CStr(beta1 * 180 / Pi))
                    BetaMin(k).Bet = beta1
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j
                    BetaMin(k).ddir = 1
                Else
                    beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj1, yj1)
                    xj_1 = Con(k1).xVer(Con(k1).NVer - 2)
                    yj_1 = Con(k1).yVer(Con(k1).NVer - 2)
                    beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                    BetaMin(k).Bet = beta1
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j
                    BetaMin(k).ddir = 1
                End If
            Else
                beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj1, yj1)
                xj_1 = Con(k1).xVer(j - 1)
                yj_1 = Con(k1).yVer(j - 1)
                beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                If beta1 > beta2 Then
                    BetaMin(k).Bet = beta2
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j
                    BetaMin(k).ddir = -1
                Else
                    BetaMin(k).Bet = beta1
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j
                    BetaMin(k).ddir = 1
                End If
            End If
            GoTo GGG
        End If
        ' If point of intersection concidences with vertex - j+1
        If Abs(xinter - xj1) < Eps And Abs(yinter - yj1) < Eps Then
'MsgBox (" inter = xj1" & " j+1=" & CStr(j + 1) & "  k1=" & CStr(k1) & "  Cont(k1).NVer - 1=" & CStr(Cont(k1).NVer - 1))
            If j + 1 = Con(k1).NVer - 1 Then
                If Con(k1).Closed = False Then
                    beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
                    BetaMin(k).Bet = beta1
                    BetaMin(k).kk = k1
                    BetaMin(k).jInit = j + 1
                    BetaMin(k).ddir = -1
                Else
                    beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
                    xj_1 = Con(k1).xVer(1)
                    yj_1 = Con(k1).yVer(1)
                    beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                    If beta1 > beta2 Then
                        BetaMin(k).Bet = beta2
                        BetaMin(k).kk = k1
                        BetaMin(k).jInit = 0
                        BetaMin(k).ddir = 1
                    Else
                        BetaMin(k).Bet = beta1
                        BetaMin(k).kk = k1
                        BetaMin(k).jInit = j + 1
                        BetaMin(k).ddir = -1
                    End If
                End If
            Else
                beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
                xj_1 = Con(k1).xVer(j + 2)
                yj_1 = Con(k1).yVer(j + 2)
                beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj_1, yj_1)
                BetaMin(k).Bet = beta1
                BetaMin(k).kk = k1
                BetaMin(k).jInit = j + 1
                BetaMin(k).ddir = -1
            End If
            GoTo GGG
        End If
'MsgBox (" Point is Internal")
        ' If point of intersection is internal point of segment j - j+1
        beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
        beta2 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj1, yj1)
        If beta1 > beta2 Then
            BetaMin(k).Bet = beta2
            BetaMin(k).kk = k1
            BetaMin(k).jInit = j
            BetaMin(k).ddir = 1
        Else
            BetaMin(k).Bet = beta1
            BetaMin(k).kk = k1
            BetaMin(k).jInit = j + 1
            BetaMin(k).ddir = -1
        End If
GGG:
'MsgBox (" k=" & CStr(k) & "  LocBet=" & CStr(BetaMin(k).Bet * 180 / Pi))

        ' Conditions for current graphic -kWork
Dim BetaWork#
        If Abs(xinter - xi1) < Eps And Abs(yinter - yi1) < Eps Then
'MsgBox ("End point" & " dir=" & CStr(dir) & " jInit + dir=" & CStr(jInit + dir))
            If ContWork.Closed = False And dir > 0 And jInit + dir = ContWork.NVer - 1 Then
                BetaMin(k2).Bet = 2 * Pi
                BetaWork = 2 * Pi
                GoTo UU1
            End If
            If ContWork.Closed = False And dir < 0 And jInit + dir = 0 Then
                BetaMin(k2).Bet = 2 * Pi
                BetaWork = 2 * Pi
                GoTo UU1
            End If
            If ContWork.Closed = True And dir > 0 And jInit + dir = ContWork.NVer - 1 Then
                xj = ContWork.xVer(1)
                yj = ContWork.yVer(1)
                BetaMin(k2).jInit = 0
                GoTo UUU
            End If
            If ContWork.Closed = True And dir < 0 And jInit + dir = 0 Then
                xj = ContWork.xVer(ContWork.NVer - 2)
                yj = ContWork.yVer(ContWork.NVer - 2)
                BetaMin(k2).jInit = ContWork.NVer - 1
                GoTo UUU
            End If
            xj = ContWork.xVer(jInit + 2 * dir)
            yj = ContWork.yVer(jInit + 2 * dir)
            BetaMin(k2).jInit = jInit + dir

UUU:
            beta1 = LocalBeta(sina, cosa, xi, yi, xinter, yinter, xj, yj)
            BetaMin(k2).Bet = beta1
            BetaWork = beta1
            BetaMin(k2).kk = -100
            BetaMin(k2).ddir = dir
UU1:
        Else
            BetaMin(k2).Bet = 0
            BetaWork = 0
            BetaMin(k2).jInit = jInit
            BetaMin(k2).kk = -100
            BetaMin(k2).ddir = dir
        End If
'MsgBox (" KKKK LocBet=" & CStr(BetaMin(k2).Bet * 180 / Pi))
    Next k

Dim BeMin#
    BeMin = 2 * Pi
    For k = 0 To k2
        If BetaMin(k).Bet < BeMin And Abs(BetaMin(k).Bet + Pi) > 0.01 And Abs(BetaMin(k).Bet + 2 * Pi) > 0.01 Then
            kmin = k
            BeMin = BetaMin(k).Bet
        End If
    Next k
'MsgBox ("BeMin=" & CStr(BeMin * 180 / Pi))
    xi = xinter
    yi = yinter
    If BetaMin(kmin).kk <> -100 Then  'And Abs(BeMin - BetaWork) > 0.001
        xi1 = Con(BetaMin(kmin).kk).xVer(BetaMin(kmin).jInit + BetaMin(kmin).ddir)
        yi1 = Con(BetaMin(kmin).kk).yVer(BetaMin(kmin).jInit + BetaMin(kmin).ddir)
        jInit = BetaMin(kmin).jInit
        dir = BetaMin(kmin).ddir
    Else
        xi1 = ContWork.xVer(BetaMin(kmin).jInit + BetaMin(kmin).ddir)
        yi1 = ContWork.yVer(BetaMin(kmin).jInit + BetaMin(kmin).ddir)
        jInit = BetaMin(kmin).jInit
        dir = BetaMin(kmin).ddir
    End If
    nVRes = nVRes + 1
    If nVRes = 9000 Then
        InitSSS = False
        Exit Function
    End If

    xCon(nVRes) = xi
    yCon(nVRes) = yi

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
' Set Gr = Grs.AddStar(xi, yi, 0)
'Gr.Properties.Item("PenColor").Value = RGB(0, 255, 0)
' Vi.Refresh
' MsgBox ("New Point")
' Gr.Deleted = True
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
    If Abs(xi - xBeg) < Eps And Abs(yi - yBeg) < Eps Then
ReDim CRes.xVer(nVRes + 1)
ReDim CRes.yVer(nVRes + 1)
        CRes.NVer = nVRes + 1
        For j = 0 To nVRes
            CRes.xVer(j) = xCon(j)
            CRes.yVer(j) = yCon(j)
        Next j
        Exit Function
    End If
    If BetaMin(kmin).kk <> -100 Then
        kWork = BetaMin(kmin).kk
        ContWork = Con(BetaMin(kmin).kk)
        NewCont = True
    End If

    GoTo LBEG1

    Exit Function

ErrHand:
'    MsgBox ("Error InitSSS")
'    MsgBox Err.Description
    InitSSS = False

End Function

' Function Return True if closed contour has Area
' and False - if it has not area

Private Function ContNotArea(Con As ContGeo) As Boolean
Dim nV As Long, i As Long
Dim xi#, yi#, xj#, yj#
    nV = Con.NVer
    ContNotArea = False
    If nV = 3 Then
        Exit Function
    End If
    For i = 1 To Int((nV - 1) / 2)
        xi = Con.xVer(i)
        yi = Con.yVer(i)
        xj = Con.xVer(nV - 1 - i)
        yj = Con.yVer(nV - 1 - i)
        If Abs(xi - xj) > Eps Or Abs(yi - yj) > Eps Then
            ContNotArea = True
            Exit Function
        End If
    Next i
End Function

Private Sub Projection(Con() As ContGeo, nG As Long)
Dim i As Long, j As LogEventTypeConstants, k As Long, i1 As Long
Dim nV As Long, nVi As Long
Dim xc#, yc#, r#
Dim rk#, rk1#, rk11#
Dim xk#, yk#, xk1#, yk1#, xk11#, yk11#
Dim xkNew#, ykNew#
Dim EpsCirc
Dim EpsCirci#, EpsCircj#, ri#, xci#, yci#, rj#, xcj#, ycj#, lMin#
Dim nVj As Long, k1 As Long, iVMin As Long, jVMin As Long
Dim ak#, bk#, dk#, ac#, bc#, dc#, xInt#, yInt#

    For i = 0 To nG - 1
        If Con(i).GrType <> "CIRCLE" Then GoTo L1
        EpsCirc = Con(i).r * Pi * Pi / nVCirc / nVCirc * 2.001
        r = Con(i).r
        xc = Con(i).xc
        yc = Con(i).yc
        nVi = Con(i).NVer
        For j = 0 To nG - 1
            If Con(j).GrType = "CIRCLE" And Con(j).Closed = True Then GoTo L2
            nV = Con(j).NVer
            For k = 0 To nV - 1
                xk = Con(j).xVer(k)
                yk = Con(j).yVer(k)
                nVi = Con(i).NVer
                For i1 = 0 To nVi - 1
                    If Abs(xk - Con(i).xVer(i1)) < Eps And Abs(yk - Con(i).yVer(i1)) < Eps Then GoTo L3
                Next i1
                rk = Sqr((xk - xc) * (xk - xc) + (yk - yc) * (yk - yc))
                If Abs(rk - r) < Eps Then
                    If k = 0 And Con(j).Closed = False Then
                        xk1 = Con(j).xVer(k + 1)
                        yk1 = Con(j).yVer(k + 1)
                        xk11 = xk1
                        yk11 = yk1
                    End If
                    If k = 0 And Con(j).Closed = True Then
                        xk1 = Con(j).xVer(k + 1)
                        yk1 = Con(j).yVer(k + 1)
                        xk11 = Con(j).xVer(nV - 2)
                        yk11 = Con(j).yVer(nV - 2)
                    End If
                    If k = nV - 1 And Con(j).Closed = False Then
                        xk11 = Con(j).xVer(k - 1)
                        yk11 = Con(j).yVer(k - 1)
                        xk1 = xk11
                        yk1 = yk11
                    End If
                    If k = nV - 1 And Con(j).Closed = True Then
                        xk1 = Con(j).xVer(1)
                        yk1 = Con(j).yVer(1)
                        xk11 = Con(j).xVer(k - 1)
                        yk11 = Con(j).yVer(k - 1)
                    End If
                    If k > 0 And k < nV - 1 Then
                        xk1 = Con(j).xVer(k + 1)
                        yk1 = Con(j).yVer(k + 1)
                        xk11 = Con(j).xVer(k - 1)
                        yk11 = Con(j).yVer(k - 1)
                    End If

                    rk1 = Sqr((xk1 - xc) * (xk1 - xc) + (yk1 - yc) * (yk1 - yc))
                    rk11 = Sqr((xk11 - xc) * (xk11 - xc) + (yk11 - yc) * (yk11 - yc))
                    If rk1 - r > EpsCirc And rk11 - r > EpsCirc Then
Dim lk1#, lk11#, xkEps#, ykEps#, rEps1#
                        lk1 = Sqr((xk1 - xk) * (xk1 - xk) + (yk1 - yk) * (yk1 - yk))
                        lk11 = Sqr((xk11 - xk) * (xk11 - xk) + (yk11 - yk) * (yk11 - yk))
                        xkEps = xk + (xk1 - xk) * EpsCirc / lk1
                        ykEps = yk + (yk1 - yk) * EpsCirc / lk1
                        rEps1 = Sqr((xkEps - xc) * (xkEps - xc) + (ykEps - yc) * (ykEps - yc))
                        If r - rEps1 > Eps Then GoTo L3
                        xkEps = xk + (xk11 - xk) * EpsCirc / lk11
                        ykEps = yk + (yk11 - yk) * EpsCirc / lk11
                        rEps1 = Sqr((xkEps - xc) * (xkEps - xc) + (ykEps - yc) * (ykEps - yc))
                        If r - rEps1 > Eps Then GoTo L3

' #######################################################################
                        lMin = 10000000
                        For k1 = 0 To nVi - 1
                            xk1 = Con(i).xVer(k1)
                            yk1 = Con(i).yVer(k1)
                            rk1 = Sqr((xk - xk1) * (xk - xk1) + (yk - yk1) * (yk - yk1))
                            If rk1 < lMin Then
                                lMin = rk1
                                iVMin = k1
                            End If
                        Next k1
                        If lMin < 2 * Pi * r / nVCirc Then
                            Con(i).xVer(iVMin) = xk
                            Con(i).yVer(iVMin) = yk
                        End If
' #######################################################################

                    End If

                End If
L3:
            Next k
L2:
        Next j
L1:
    Next i

' Editing tangent circles

    For i = 0 To nG - 1
        If Con(i).GrType = "CIRCLE" Then
            EpsCirci = Con(i).r * Pi * Pi / nVCirc / nVCirc * 2.001
            ri = Con(i).r
            xci = Con(i).xc
            yci = Con(i).yc
            For j = 0 To nG - 1
                If Con(j).GrType = "CIRCLE" And i <> j Then
                    EpsCircj = Con(j).r * Pi * Pi / nVCirc / nVCirc * 2.001
                    rj = Con(j).r
                    xcj = Con(j).xc
                    ycj = Con(j).yc
                    r = Sqr((xci - xcj) * (xci - xcj) + (yci - ycj) * (yci - ycj))
                    If Abs(r - (ri + rj)) > Eps Then GoTo C1
                    nVi = Con(i).NVer
                    nVj = Con(j).NVer
                    lMin = 10000000
                    For k = 0 To nVi - 1
                        xk = Con(i).xVer(k)
                        yk = Con(i).yVer(k)
                        For k1 = 0 To nVj - 1
                            xk1 = Con(j).xVer(k1)
                            yk1 = Con(j).yVer(k1)
                            rk = Sqr((xk - xk1) * (xk - xk1) + (yk - yk1) * (yk - yk1))
                            If rk < lMin Then
                                lMin = rk
                                iVMin = k
                                jVMin = k1
                            End If
                        Next k1
                    Next k
                    If lMin < Pi * (ri + rj) / nVCirc Then
                        xkNew = (Con(i).xVer(iVMin) + Con(j).xVer(jVMin)) / 2
                        ykNew = (Con(i).yVer(iVMin) + Con(j).yVer(jVMin)) / 2
                        Con(i).xVer(iVMin) = xkNew
                        Con(i).yVer(iVMin) = ykNew
                        Con(j).xVer(jVMin) = xkNew
                        Con(j).yVer(jVMin) = ykNew
                    End If
                End If
C1:
            Next j
        End If
   Next i
' Editing lines tangen to circle

    For i = 0 To nG - 1
        If Con(i).GrType = "CIRCLE" Then
            EpsCirci = Con(i).r * Pi * Pi / nVCirc / nVCirc * 2.001
            ri = Con(i).r
            xci = Con(i).xc
            yci = Con(i).yc
            nVi = Con(i).NVer
            For j = 0 To nG - 1
                If Con(j).GrType <> "CIRCLE" Then
                    nVj = Con(j).NVer
                    For k = 0 To nVj - 2
                        xk = Con(j).xVer(k)
                        yk = Con(j).yVer(k)
                        xk1 = Con(j).xVer(k + 1)
                        yk1 = Con(j).yVer(k + 1)
                        ak = -(yk1 - yk)
                        bk = xk1 - xk
                        dk = ak * xk + bk * yk
                        If Abs(ak) < Eps And Abs(bk) < Eps Then GoTo LC1
                        rk = Abs((ak * xci + bk * yci - dk) / Sqr(ak * ak + bk * bk))
                        If Abs(rk - ri) > Eps Then GoTo LC1
                        ac = -bk
                        bc = ak
                        dc = ac * xci + bc * yci
                        If SysLine(ak, bk, dk, ac, bc, dc, xInt, yInt) = False Then GoTo LC1
                        If PointIntoSegmentjj(xk, yk, xk1, yk1, xInt, yInt) = 0 Then GoTo LC1
                        lMin = 10000000
                        For k1 = 0 To nVi - 1
                            xk1 = Con(i).xVer(k1)
                            yk1 = Con(i).yVer(k1)
                            rk1 = Sqr((xInt - xk1) * (xInt - xk1) + (yInt - yk1) * (yInt - yk1))
                            If rk1 < lMin Then
                                lMin = rk1
                                iVMin = k1
                            End If
                        Next k1
                        If lMin < 2 * Pi * ri / nVCirc Then
                            Con(i).xVer(iVMin) = xInt
                            Con(i).yVer(iVMin) = yInt
                        End If
LC1:
                    Next k
                End If
            Next j
        End If
    Next i
End Sub
' Function return 1 - if point lies inside of the contour ,
' or 0 - if point lies outside or on o bounds of the contour

' Function return 1 - if point lies inside of the contour or on o bounds of the contour,
' or 0 - if point lies outside

Private Function PointIntoContour(Con As ContGeo, xc#, yc#) As Integer
On Error GoTo ErrorHandler
Dim nV As Long, i%
Dim xi#, yi#, xi1#, yi1#
Dim xLoci#, yLoci#, xLoci1#, yLoci1#
Dim nInt%
Dim a1#, b1#, d1#
Dim xIntLoc#
Dim sina#, cosa#
    PointIntoContour = 0
    nV = Con.NVer
    nInt = 0
    sina = 0.5
    cosa = Sqr(3) / 2
    For i = 0 To nV - 2
        xi = Con.xVer(i)
        yi = Con.yVer(i)
        xi1 = Con.xVer(i + 1)
        yi1 = Con.yVer(i + 1)
        If Abs(xi - xi1) < Eps And Abs(yi - yi1) < Eps Then GoTo WW1
        If Abs(xc - xi) < Eps And Abs(yc - yi) < Eps Then
            PointIntoContour = 1
            Exit Function
        End If
        If Abs(xc - xi1) < Eps And Abs(yc - yi1) < Eps Then
            PointIntoContour = 1
            Exit Function
        End If
        If Abs(yi - yi1) < Eps Then
            If Abs(yc - yi) < Eps And PointIntoSegmenti(xi, yi, xi1, yi1, xc, yc) = 1 Then
                PointIntoContour = 1
                Exit Function
            End If
        End If

        yLoci = (yi - yc) * cosa - (xi - xc) * sina
        xLoci = (yi - yc) * sina + (xi - xc) * cosa
        yLoci1 = (yi1 - yc) * cosa - (xi1 - xc) * sina
        xLoci1 = (yi1 - yc) * sina + (xi1 - xc) * cosa

        If yLoci > 10 * Eps And yLoci1 > 10 * Eps Then GoTo WW1
        If yLoci < -10 * Eps And yLoci1 < -10 * Eps Then GoTo WW1
        If Abs(yLoci - yLoci1) < Eps Then GoTo WW1      'And Abs(yLocj) > 10 * Eps
        If xLoci < -10 * Eps And xLoci1 < -10 * Eps Then GoTo WW1
        If Sgn(yLoci) <> Sgn(yLoci1) Then
            a1 = -(yLoci1 - yLoci)
            b1 = xLoci1 - xLoci
            d1 = a1 * xLoci + b1 * yLoci
            If Abs(a1) < Eps And Abs(b1) < Eps Then GoTo WW1
            xIntLoc = d1 / a1
      ' If point on line
            If Abs(xIntLoc) < Eps Then
                PointIntoContour = 1
                Exit Function
            End If
            If xIntLoc > Eps Then
                nInt = nInt + 1
            End If
        End If
WW1:
    Next i
    If nInt = 0 Or nInt = 2 Or nInt = 4 Or nInt = 6 Or nInt = 8 Or nInt = 10 Or nInt = 12 Then
        PointIntoContour = 0
    Else
        PointIntoContour = 1
    End If
    Exit Function

ErrorHandler:
'    MsgBox ("Error PointIntoContourii")
'    MsgBox Err.Msg

End Function

' Function return 1 - if point lies inside of the contour ,
' or 0 - if point lies outside or on o bounds of the contour

Private Function PointInsideContour(Con As ContGeo, xc#, yc#) As Integer
On Error GoTo ErrorHandler
Dim nV As Long, i%
Dim xi#, yi#, xi1#, yi1#
Dim xLoci#, yLoci#, xLoci1#, yLoci1#
Dim nInt%
Dim a1#, b1#, d1#
Dim xIntLoc#
Dim sina#, cosa#
    PointInsideContour = 0
    nV = Con.NVer
    nInt = 0
    sina = 0.5
    cosa = Sqr(3) / 2
    For i = 0 To nV - 2
        xi = Con.xVer(i)
        yi = Con.yVer(i)
        xi1 = Con.xVer(i + 1)
        yi1 = Con.yVer(i + 1)
        If Abs(xi - xi1) < Eps And Abs(yi - yi1) < Eps Then GoTo WW1
        If Abs(xc - xi) < Eps And Abs(yc - yi) < Eps Then
            PointInsideContour = 0
            Exit Function
        End If
        If Abs(xc - xi1) < Eps And Abs(yc - yi1) < Eps Then
            PointInsideContour = 0
            Exit Function
        End If
        If Abs(yi - yi1) < Eps Then
            If Abs(yc - yi) < Eps And PointIntoSegmenti(xi, yi, xi1, yi1, xc, yc) = 1 Then
                PointInsideContour = 0
                Exit Function
            End If
        End If

        yLoci = (yi - yc) * cosa - (xi - xc) * sina
        xLoci = (yi - yc) * sina + (xi - xc) * cosa
        yLoci1 = (yi1 - yc) * cosa - (xi1 - xc) * sina
        xLoci1 = (yi1 - yc) * sina + (xi1 - xc) * cosa

        If yLoci > 10 * Eps And yLoci1 > 10 * Eps Then GoTo WW1
        If yLoci < -10 * Eps And yLoci1 < -10 * Eps Then GoTo WW1
        If Abs(yLoci - yLoci1) < Eps Then GoTo WW1      'And Abs(yLocj) > 10 * Eps
        If xLoci < -10 * Eps And xLoci1 < -10 * Eps Then GoTo WW1
        If Sgn(yLoci) <> Sgn(yLoci1) Then
            a1 = -(yLoci1 - yLoci)
            b1 = xLoci1 - xLoci
            d1 = a1 * xLoci + b1 * yLoci
            If Abs(a1) < Eps And Abs(b1) < Eps Then GoTo WW1
            xIntLoc = d1 / a1
      ' If point on line
            If Abs(xIntLoc) < Eps Then
                PointInsideContour = 0
                Exit Function
            End If
            If xIntLoc > Eps Then
                nInt = nInt + 1
            End If
        End If
WW1:
    Next i
    If nInt = 0 Or nInt = 2 Or nInt = 4 Or nInt = 6 Or nInt = 8 Or nInt = 10 Or nInt = 12 Then
        PointInsideContour = 0
    Else
        PointInsideContour = 1
    End If
    Exit Function

ErrorHandler:
 '   MsgBox ("Error PointInsideContourii")
 '   MsgBox Err.Msg

End Function

Private Function LeftPoint(Con As ContGeo, xc#, yc#) As Double
On Error GoTo ErrorHandler
Dim nV As Long, i%
Dim xi#, yi#, xi1#, yi1#
Dim xLoci#, yLoci#, xLoci1#, yLoci1#
Dim a1#, b1#, d1#
Dim xIntLoc#, xInt#, xLeft#
Dim sina#, cosa#
    xLeft = xc
    nV = Con.NVer
    For i = 0 To nV - 2
        xi = Con.xVer(i)
        yi = Con.yVer(i)
        xi1 = Con.xVer(i + 1)
        yi1 = Con.yVer(i + 1)
        yLoci = yi - yc
        xLoci = xi - xc
        yLoci1 = yi1 - yc
        xLoci1 = xi1 - xc
        If Abs(yi - yi1) < Eps Then GoTo WW1
        If Abs(xi - xi1) < Eps And Abs(yi - yi1) < Eps Then GoTo WW1
        If Sgn(yLoci) <> Sgn(yLoci1) Then
            a1 = -(yLoci1 - yLoci)
            If Abs(a1) < Eps Then GoTo WW1
            b1 = xLoci1 - xLoci
            d1 = a1 * xLoci + b1 * yLoci
            xIntLoc = d1 / a1
            xInt = xIntLoc + xc
            If xInt < xLeft Then xLeft = xInt
        End If
WW1:
    Next i
    LeftPoint = xLeft
    Exit Function
ErrorHandler:
    LeftPoint = 10000000
 '   MsgBox ("Error LeftPoint")
 '   MsgBox Err.Msg

End Function

' Define two points intersection - xMin,xMax for closed contour - Con with horizontal
' line with coordinate -y

Private Function BiPointInter(Con As ContGeo, y#, xMin#, xMax#) As Long
On Error GoTo ErrorHandler
Dim nV As Long, i As Long
Dim xi#, yi#, xi1#, yi1#
Dim nInt As Long
Dim a0#, b0#, d0#, a1#, b1#, d1#
Dim xInt#, yInt#
    xMin = 1000000
    xMax = -1000000
    nV = Con.NVer
    nInt = 0
    a0 = 0
    b0 = 1
    d0 = y

    For i = 0 To nV - 2
        xi = Con.xVer(i)
        yi = Con.yVer(i)
        xi1 = Con.xVer(i + 1)
        yi1 = Con.yVer(i + 1)
        If Abs(xi1 - xi) < Eps And Abs(yi1 - yi) < Eps Then GoTo WW1
        If yi - y > Eps And yi1 - y > Eps Then GoTo WW1
        If y - yi > Eps And y - yi1 > Eps Then GoTo WW1
        If Abs(yi1 - y) < Eps Then
            nInt = nInt + 1
            xInt = xi1
            If xi1 > xMax Then
                xMax = xi1
            End If
            If xi1 < xMin Then
                xMin = xi1
            End If
            GoTo WW1
        End If
        If Abs(yi - y) < Eps Then GoTo WW1

        a1 = -(yi1 - yi)
        b1 = xi1 - xi
        d1 = a1 * xi + b1 * yi
        Call SysLine(a0, b0, d0, a1, b1, d1, xInt, yInt)
        nInt = nInt + 1
        If xInt > xMax Then
            xMax = xInt
        End If
        If xInt < xMin Then
            xMin = xInt
        End If
WW1:
    Next i
    BiPointInter = nInt

    Exit Function

ErrorHandler:
 '   MsgBox ("Error PointInsideContourii")
 '   MsgBox Err.Msg
End Function

' Define all points intersection -xInt(N) for closed contour - Con with horizontal
' line with coordinate -y

Private Function AllPointInter(Con As ContGeo, y#, ConInt() As HorizInt) As Integer
On Error GoTo ErrorHandler
Dim nV As Long, i As Long
Dim xi#, yi#, xi1#, yi1#
Dim nInt As Long
Dim a0#, b0#, d0#, a1#, b1#, d1#
Dim xInt#, yInt#
    nV = Con.NVer
    nInt = -1
    a0 = 0
    b0 = 1
    d0 = y

    For i = 0 To nV - 2
        xi = Con.xVer(i)
        yi = Con.yVer(i)
        xi1 = Con.xVer(i + 1)
        yi1 = Con.yVer(i + 1)
        If Abs(xi1 - xi) < Eps And Abs(yi1 - yi) < Eps Then GoTo WW1
        If yi - y > Eps And yi1 - y > Eps Then GoTo WW1
        If y - yi > Eps And y - yi1 > Eps Then GoTo WW1
        If Abs(yi1 - y) < Eps Then
            nInt = nInt + 1
            ConInt(nInt).xInt = xi1
            ConInt(nInt).yInt = y
            GoTo WW1
        End If
        If Abs(yi - y) < Eps Then GoTo WW1

        a1 = -(yi1 - yi)
        b1 = xi1 - xi
        d1 = a1 * xi + b1 * yi
        Call SysLine(a0, b0, d0, a1, b1, d1, xInt, yInt)
        nInt = nInt + 1
        ConInt(nInt).xInt = xInt
        ConInt(nInt).yInt = y

WW1:
    Next i
    AllPointInter = nInt

    Exit Function

ErrorHandler:
 '   MsgBox ("Error PointInsideContourii")
 '   MsgBox Err.Msg
End Function

Private Function HorizontalIntersection(Con() As ContGeo, ncont As Long, iExt As Long)
Dim i As Long, j As Long, nV As Long
Dim GrGroup As Graphic
Dim GrChild As Graphic
Dim GrHatch As Graphic
Dim Vers As Vertices
    Set GrGroup = Grs.Add(11)
    For i = 0 To ncont
        Set GrChild = GrGroup.Graphics.Add(11)
        nV = Con(i).NVer
        With GrChild.Vertices
            For j = 0 To nV - 1
                .Add Con(i).xVer(j), Con(i).yVer(j), 0
            Next j
        End With
        GrChild.Closed = True
    Next i

    Set GrHatch = GrGroup.Graphics.AddHatch
    If Dr.Properties("TileMode") = 1 Then
        GrHatch.Properties("Thickness") = 0
    End If
    GrHatch.Properties("PenColor") = RGB(0, 255, 0)
    GrGroup.Deleted = True

'    Gr.Select

Dim hDrawing As Long
Dim hGraphic As Long
Dim Res%
Dim Res1 As Boolean
    hDrawing = TCWDrawingActive()
    hGraphic = TCWGraphicAt(hDrawing, GrHatch.Index)
    Res1 = GraphicSetMatrix(hGraphic, hMWorkPlane)
    GrHatch.Draw

    GeometryNew Con, ncont, iExt

'    Res = TCWUndoRecordStart(hDrawing, "PickHatchGraphic")
'    Res = TCWUndoRecordAddGraphic(hDrawing, hGraphic)
'    Res = TCWUndoRecordEnd(hDrawing)
    GrHatch.Deleted = True
    Vi.Refresh

    Set Vers = Nothing
    Set GrHatch = Nothing
    Set GrChild = Nothing
    Set GrGroup = Nothing

End Function

Private Function ExplodeWithUnVisible(GrExp As Graphic, GrSet As GraphicSet)
Dim nV As Long, i As Long
Dim Vers As Vertices
Dim VersE As Vertices
Dim Ver As Vertex
Dim VerNext As Vertex
Dim GrE As Graphic
Dim VerE As Vertex
Dim hGr As Long
Dim Res As Boolean
    Set Vers = GrExp.Vertices
    Vers.UseWorldCS = False
    nV = Vers.Count
    If Vers(1).PenDown = True Then
'        Set GrE = GrSet.Add(11)
        Set GrE = Grs.Add(11) ' ??????
        hGr = TCWGraphicAt(hDr, GrE.Index)  '???????????????
        Res = GraphicSetMatrix(hGr, hMWorkPlane)    '???????
        Grs.Remove GrE.Index
        GrSet.AddGraphic GrE '??????????

        Set VersE = GrE.Vertices
         VersE.UseWorldCS = False
        Set Ver = Vers.Item(0)
        Set VerE = VersE.Add(Ver.x, Ver.y, 0)
    End If
    For i = 1 To nV - 2
        Set Ver = Vers.Item(i)
        Set VerNext = Vers.Item(i + 1)
        If GrExp.Vertices.Item(i).PenDown = True Then
            Set VerE = VersE.Add(Ver.x, Ver.y, 0)
        Else
            If GrExp.Vertices.Item(i + 1).PenDown = True Then
'                Set GrE = GrSet.Add(11)
                Set GrE = Grs.Add(11) ' ??????
                hGr = TCWGraphicAt(hDr, GrE.Index)  '???????????????
                Res = GraphicSetMatrix(hGr, hMWorkPlane)    '???????
                Grs.Remove GrE.Index
                GrSet.AddGraphic GrE '??????????
                Set VersE = GrE.Vertices
                VersE.UseWorldCS = False
                Set VerE = VersE.Add(Ver.x, Ver.y, 0)
            End If
        End If
    Next i
    Set Ver = Vers.Item(nV - 2)
    Set VerNext = Vers.Item(nV - 1)
    If Vers(nV - 1).PenDown = True And Vers(nV - 2).PenDown = True Then
        Set VerE = VersE.Add(VerNext.x, VerNext.y, 0)
    End If
    Set Ver = Nothing
    Set VerNext = Nothing
    Set VerE = Nothing
    Set VersE = Nothing
    Set Vers = Nothing
    Set GrE = Nothing

End Function

Private Function Sign(y As Double) As Double
    If Abs(y) < 0.001 Then
        Sign = 0
        Exit Function
    End If
    If y < 0 Then
        Sign = -1#
        Exit Function
    End If
    If y > 0 Then
        Sign = 1#
        Exit Function
    End If
End Function

Private Sub DeleteTail(Con() As ContGeo, ncont As Long)

Dim i As Long, j As Long, k As Long
Dim nV As Long
Dim ConTem As ContGeo
Dim xj#, yj#, xj1#, yj1#, xj_1#, yj_1#
Dim j0 As Long

    For i = 0 To ncont
        ConTem = Con(i)
        nV = ConTem.NVer
ReDim ConTem.Deleted(nV)
        For j = 0 To nV - 1
            ConTem.Deleted(j) = False
        Next j
        For j = 0 To nV - 2
            k = 1
            If j = 0 Then
                j0 = nV - 1
            Else
                j0 = j
            End If
            xj = ConTem.xVer(j)
            yj = ConTem.yVer(j)
            xj1 = ConTem.xVer(j + k)
            yj1 = ConTem.yVer(j + k)
            xj_1 = ConTem.xVer(j0 - k)
            yj_1 = ConTem.yVer(j0 - k)
            If Abs(xj1 - xj_1) < Eps And Abs(yj1 - yj_1) < Eps Then
                ConTem.Deleted(j) = True
                If j = 0 Then ConTem.Deleted(nV - 1) = True
                ConTem.Deleted(j + k) = True
                ConTem.Deleted(j0 - k) = True
                For k = 2 To nV - 1
                    xj1 = ConTem.xVer(j + k)
                    yj1 = ConTem.yVer(j + k)
                    xj_1 = ConTem.xVer(j0 - k)
                    yj_1 = ConTem.yVer(j0 - k)
                    If Abs(xj1 - xj_1) < Eps And Abs(yj1 - yj_1) < Eps Then
                        ConTem.Deleted(j + k) = True
                        ConTem.Deleted(j0 - k) = True
                    Else
                        If j <> 0 Then
                            ConTem.Deleted(j + k - 1) = False
                        Else
                            ConTem.Deleted(j + k - 1) = False
                            ConTem.Deleted(j0 - k + 1) = False
                        End If
                        GoTo LL
                    End If
                Next k
LL:
            End If
        Next j
Dim nVi As Long
        nVi = 0
        For j = 0 To nV - 1
            If ConTem.Deleted(j) = False Then
                Con(i).xVer(nVi) = ConTem.xVer(j)
                Con(i).yVer(nVi) = ConTem.yVer(j)
                nVi = nVi + 1
            End If
        Next j
        Con(i).NVer = nVi
    Next i
End Sub

Private Sub ViewToWorkPlane(xVi#, yVi#, zVi#, xWP#, yWP#, zWP#)
    If hMWorkPlane = 0 Then
        Vi.ViewToWorld xVi, yVi, zVi, xWP, yWP, zWP
    Else
Dim Gr1 As Graphic
Dim Vers1 As Vertices
Dim Ver1 As Vertex
Dim hGr As Long
Dim hVer As Long
Dim Res As Boolean
        Set Gr1 = Grs.Add(11)
        hGr = TCWGraphicAt(hDr, Gr1.Index)
        Set Vers1 = Gr1.Vertices
        Set Ver1 = Vers1.Add(0, 0, 0)
        hVer = TCWVertexAt(hGr, Ver1.Index)
        Vers1.Remove 0
        Ver1.x = xVi
        Ver1.y = yVi
        Ver1.Z = 0
        Res = WorldToWorkPlane(hDr, hVer, hVer, hMViewPort)
        xWP = Ver1.x
        yWP = Ver1.y
        zWP = Ver1.Z
        Ver1.Delete
        Gr1.Deleted = True
        Set Ver1 = Nothing
        Set Vers1 = Nothing
        Set Gr1 = Nothing
    End If

End Sub

Private Sub WorkPlaneToView(xWP#, yWP#, zWP#, xVi#, yVi#, zVi#)
    If hMWorkPlane = 0 Then
        Vi.WorldToView xWP#, yWP#, zWP#, xVi#, yVi#, zVi#
    Else
Dim Gr1 As Graphic
Dim Vers1 As Vertices
Dim Ver1 As Vertex
Dim hGr As Long
Dim hVer As Long
Dim Res As Boolean
        Set Gr1 = Grs.Add(11)
        hGr = TCWGraphicAt(hDr, Gr1.Index)
        Set Vers1 = Gr1.Vertices
        Set Ver1 = Vers1.Add(0, 0, 0)
        hVer = TCWVertexAt(hGr, Ver1.Index)
        Vers1.Remove 0
        Ver1.x = xWP
        Ver1.y = yWP
        Ver1.Z = zWP
        Res = WorkPlaneToWorld(hDr, hVer, hVer, hMViewPort)
        xVi = Ver1.x
        yVi = Ver1.y
        zVi = Ver1.Z
        Ver1.Delete
        Gr1.Deleted = True
        Set Ver1 = Nothing
        Set Vers1 = Nothing
        Set Gr1 = Nothing
    End If
End Sub

Private Function FormString(x As Double) As String
Dim Str$

    If Abs(x) > 100000 Then
        Str = "###0"
    End If
    If Abs(x) > 100 And Abs(x) < 100000 Then
        Str = "###0.00"
    End If
    If Abs(x) <= 100 And Abs(x) > 1 Then
        Str = "###0.0000"
    End If
     If Abs(x) <= 1 Then
        Str = "###0.000000"
    End If
    FormString = Str

End Function

'#################################################################
'#################################################################
'#################################################################
'#################################################################
'#################################################################

'Research Geometry for created Contour
Private Sub GeometryNew(Con() As ContGeo, ncont As Long, iExt As Long)
Dim Si() As Double
ReDim Si(ncont + 1)
Dim xci() As Double
ReDim xci(ncont + 1)
Dim yci() As Double
ReDim yci(ncont + 1)
Dim Jx0i() As Double
ReDim Jx0i(ncont + 1)
Dim Jy0i() As Double
ReDim Jy0i(ncont + 1)

Dim Jxy0i() As Double
ReDim Jxy0i(ncont + 1)

Dim nV As Long, i As Long, j As Long
    For i = 0 To ncont
        ClosedGraphicMomentInertiaNewNew Con(i), Jx0i(i), Jy0i(i), Si(i), xci(i), yci(i), Jxy0i(i)

'        Set Gr = Grs.AddStar(xci(i), yci(i), 0)
'        Gr.Properties("PenColor") = RGB(0, 255, 0)
    Next i
Dim S0xc#, S0yc#
    S0T = 0
    S0xc = 0
    S0yc = 0
Dim Jx0#, Jy0#
    Jx0 = 0
    Jy0 = 0
Dim Jxy0#
    Jxy0 = 0

Dim SExt#
    For i = 0 To ncont
        If i = iExt Then
            S0T = S0T + Si(i)
            SExt = Si(i)
            S0xc = S0xc + Si(i) * xci(i)
            S0yc = S0yc + Si(i) * yci(i)
            Jx0 = Jx0 + Jx0i(i)
            Jy0 = Jy0 + Jy0i(i)
'MsgBox ("0000 Jx0=" & CStr(Jx0) & "  Jy0=" & CStr(Jy0))
            Jxy0 = Jxy0 + Jxy0i(i)

        Else
            S0T = S0T - Si(i)
            S0xc = S0xc - Si(i) * xci(i)
            S0yc = S0yc - Si(i) * yci(i)
            Jx0 = Jx0 - Jx0i(i)
            Jy0 = Jy0 - Jy0i(i)
' MsgBox ("11111 Jx0=" & CStr(Jx0) & "  Jy0=" & CStr(Jy0))
           Jxy0 = Jxy0 - Jxy0i(i)

        End If
    Next i
'MsgBox ("S0=" & CStr(S0))
'MsgBox (" Jxy0=" & CStr(Jxy0)) ' & "  SExt=" & CStr(SExt))

' Define base moments inertia
'Dim Jxc#, Jyc#, xc#, yc#
'Dim Jxyc#
    xcT = S0xc / S0T
    ycT = S0yc / S0T
    If xcT < 0.0001 Then xcT = 0
    If ycT < 0.0001 Then ycT = 0

    JxcT = Jx0 - S0T * ycT * ycT
    JycT = Jy0 - S0T * xcT * xcT
    JxycT = Jxy0 - S0T * xcT * ycT
    If Abs(JxycT) / ((JxcT + JycT) / 2) < 0.001 Then
        JxycT = 0#
    End If

Dim Alp#
    Alp = 0#
    If Abs(JxycT) > 0.001 And Abs(JxcT - JycT) > 0.001 Then
        Alp = Abs(-Atn(2 * JxycT / (JxcT - JycT)) / 2)
    End If

' #########################################################################
' Define the Base Section Modulus
Dim xMaxc#, yMaxc# ' Max distant from xc or yc to contour
Dim xj#, yj#
    xMaxc = 0
    yMaxc = 0
    For i = 0 To ncont
        With Con(i)
            nV = .NVer
            For j = 0 To nV - 1
                xj = .xVer(j)
                yj = .yVer(j)
                If Abs(xj - xcT) > xMaxc Then xMaxc = Abs(xj - xcT)
                If Abs(yj - ycT) > yMaxc Then yMaxc = Abs(yj - ycT)
            Next j
        End With
    Next i
'Dim Wxc#, Wyc# ' Section Modulus relariv center of gravity
    WxcT = JxcT / yMaxc
    WycT = JycT / xMaxc
'MsgBox ("Jxc=" & CStr(Jxc) & "  yMaxc=" & CStr(yMaxc))

' #########################################################################

'MsgBox (" Jxyc=" & CStr(Jxyc))
Dim Space%
        Space = Dr.Properties("TileMode") ' Modal or Paper space
Dim UnitName$
        If Space <> 1 Then
            UnitName = Dr.Properties("PaperLinearUnitName")
        Else
            UnitName = Dr.Properties("LinearUnitName")
        End If

    If UnitName = """" Then UnitName = "in"
    If UnitName = "'" Then UnitName = "ft"

    DrUnit = UnitName

Dim GrCW As Graphic, GrAxis As Graphic
Dim AxisColor As Long
    AxisColor = RGB(255, 0, 0)

    Set GrCW = Grs.Add(imsiGroup)
'    Set GrStar = GrCW.Graphics.AddStar(xc, yc, 0)
Dim ViHeight#
    ViHeight = Vi.ViewHeight
'    GrStar.Properties("$POINTSIZE") = ViHeight / 40

    Set GrAxis = GrCW.Graphics.AddCircleCenterAndPoint(xcT, ycT, 0, xcT + ViHeight / 300, ycT, 0)
        GrAxis.Properties("PenColor") = AxisColor
        GrAxis.Properties("Brushstyle") = "Solid"

Dim ArrL#, ArrW#
    ArrL = ViHeight / 50
    ArrW = ViHeight / 100
Dim GrArrow As Graphic, GrArrowDup As Graphic
    Set GrArrow = GrCW.Graphics.Add(11)
        GrArrow.Properties("PenColor") = AxisColor
        GrArrow.Properties("Brushstyle") = "Solid"
        With GrArrow.Vertices
            .Add 0, 0, 0
            .Add ArrL, ArrW / 2, 0
            .Add ArrL, -ArrW / 2, 0
            .AddClose
        End With
    Set GrArrowDup = GrArrow.Duplicate

    Set GrAxis = GrCW.Graphics.Add(11)
        GrAxis.Properties("PenColor") = AxisColor
        With GrAxis.Vertices
            .Add xcT, ycT, 0
            .Add xcT + ViHeight / 10, ycT, 0
        End With
        GrArrow.RotateAxis Pi, 0, 0, 1, 0, 0, 0
        GrArrow.MoveRelative xcT + ViHeight / 10 + ArrL, ycT, 0
        Set GrArrow = Nothing

    Set GrAxis = GrCW.Graphics.Add(11)
        GrAxis.Properties("PenColor") = AxisColor
        With GrAxis.Vertices
            .Add xcT, ycT, 0
            .Add xcT, ycT + ViHeight / 10, 0
        End With
        GrArrowDup.RotateAxis -Pi / 2, 0, 0, 1, 0, 0, 0
        GrArrowDup.MoveRelative xcT, ycT + ViHeight / 10 + ArrL, 0
        Set GrArrowDup = Nothing

    If Abs(Alp) > 0.0001 Then
        GrCW.RotateAxis Alp, 0, 0, 1, xcT, ycT, 0
    End If

Dim hDr As Long
Dim hGr As Long
Dim Res%
Dim Res1 As Boolean
    hDr = TCWDrawingActive()
    hGr = TCWGraphicAt(hDr, GrCW.Index)
    Res1 = GraphicSetMatrix(hGr, hMWorkPlane)
    GrCW.Draw

Dim StrxNorm$, Strst$
    Load frmParameters
    frmParameters.Units.Text = UnitName
'    frmParameters.xc.Caption = Format(xc, FormString(xc)) & " " & UnitName
    NumNormalize xcT, StrxNorm, Strst
    frmParameters.xc.Caption = StrxNorm
    frmParameters.Stxc.Caption = "*10^" & Strst & " " & UnitName

'    frmParameters.yc.Caption = Format(yc, FormString(yc)) & " " & UnitName
    NumNormalize ycT, StrxNorm, Strst
    frmParameters.yc.Caption = StrxNorm
    frmParameters.Styc.Caption = "*10^" & Strst & " " & UnitName

'    frmParameters.AreaFull.Caption = Format(S0, FormString(S0)) & " " & UnitName & Chr(178)
    NumNormalize S0T, StrxNorm, Strst
    frmParameters.AreaFull.Caption = StrxNorm
    frmParameters.StAreaFull.Caption = "*10^" & Strst & " " & UnitName & "^2"

'    frmParameters.AreaHoles.Caption = Format(SExt - S0, FormString(SExt - S0)) & " " & UnitName & Chr(178)
    SIntT = SExt - S0T
    NumNormalize SIntT, StrxNorm, Strst
    frmParameters.AreaHoles.Caption = StrxNorm
    frmParameters.StAreaHoles.Caption = "*10^" & Strst & " " & UnitName & "^2"

'    frmParameters.Jxc.Caption = Format(Jxc, FormString(Jxc)) & " " & UnitName & Chr(178) & Chr(215) & " " & UnitName & Chr(178)
    NumNormalize JxcT, StrxNorm, Strst
    frmParameters.Jxc.Caption = StrxNorm
    frmParameters.StJxc.Caption = "*10^" & Strst & " " & UnitName & "^4"

'    frmParameters.Jyc.Caption = Format(Jyc, FormString(Jyc)) & " " & UnitName & Chr(178) & Chr(215) & " " & UnitName & Chr(178)
    NumNormalize JycT, StrxNorm, Strst
    frmParameters.Jyc.Caption = StrxNorm
    frmParameters.StJyc.Caption = "*10^" & Strst & " " & UnitName & "^4"

'    frmParameters.Jxyc.Caption = Format(Abs(Jxyc), FormString(Abs(Jxyc))) & " " & UnitName & Chr(178) & Chr(215) & " " & UnitName & Chr(178)
    NumNormalize JxycT, StrxNorm, Strst
    frmParameters.Jxyc.Caption = StrxNorm
    frmParameters.StJxyc.Caption = "*10^" & Strst & " " & UnitName & "^4"

'    frmParameters.Jp.Caption = Format(Jxc + Jyc, FormString(Jxc + Jyc)) & " " & UnitName & Chr(178) & Chr(215) & " " & UnitName & Chr(178)
    JpT = JxcT + JycT
    NumNormalize JpT, StrxNorm, Strst
    frmParameters.Jp.Caption = StrxNorm
    frmParameters.StJp.Caption = "*10^" & Strst & " " & UnitName & "^4"

'    frmParameters.kx.Caption = Format(Sqr(Jxc / S0), FormString(Sqr(Jxc / S0))) & " " & UnitName
    KxT = Sqr(JxcT / S0T)
    NumNormalize KxT, StrxNorm, Strst
    frmParameters.kx.Caption = StrxNorm
    frmParameters.Stkx.Caption = "*10^" & Strst & " " & UnitName

'    frmParameters.ky.Caption = Format(Sqr(Jyc / S0), FormString(Sqr(Jyc / S0))) & " " & UnitName
    KyT = Sqr(JycT / S0T)
    NumNormalize KyT, StrxNorm, Strst
    frmParameters.ky.Caption = StrxNorm
    frmParameters.Stky.Caption = "*10^" & Strst & " " & UnitName

    NumNormalize WxcT, StrxNorm, Strst
    frmParameters.Zxc.Caption = StrxNorm
    frmParameters.StZxc.Caption = "*10^" & Strst & " " & UnitName & "^3"

    NumNormalize WycT, StrxNorm, Strst
    frmParameters.Zyc.Caption = StrxNorm
    frmParameters.StZyc.Caption = "*10^" & Strst & " " & UnitName & "^3"

    frmParameters.Angle.Caption = Format(Alp * 180 / Pi, "###0.0") & Chr(176)
'Dim Jaxis#
    JaxisT = 0
    If Abs(x0Base) > Eps Or Abs(y0Base) > Eps Or Abs(x1Base) > Eps Or Abs(y1Base) > Eps Then
Dim l#, sina#, cosa#, Dist#
        l = Sqr((x1Base - x0Base) * (x1Base - x0Base) + (y1Base - y0Base) * (y1Base - y0Base))
        sina = (y1Base - y0Base) / l
        cosa = (x1Base - x0Base) / l
        Dist = (ycT - y0Base) * cosa - (xcT - x0Base) * sina
        JaxisT = JxcT * cosa * cosa + JycT * sina * sina - JxycT * 2 * sina * cosa
        JaxisT = JaxisT + S0T * Dist * Dist
        NumNormalize JaxisT, StrxNorm, Strst
        frmParameters.Jaxis.Caption = StrxNorm
        frmParameters.StJaxis.Caption = "*10^" & Strst & " " & UnitName & "^4"
Dim yLocAxisMax#, yLocAxis# ', Waxis#
        yLocAxisMax = 0
        For i = 0 To ncont
            With Con(i)
                nV = .NVer
                For j = 0 To nV - 1
                    xj = .xVer(j)
                    yj = .yVer(j)
                    yLocAxis = (yj - y0Base) * cosa - (xj - x0Base) * sina
                    If Abs(yLocAxis) > yLocAxisMax Then yLocAxisMax = Abs(yLocAxis)
                Next j
            End With
        Next i
        WaxisT = JaxisT / yLocAxisMax
        NumNormalize WaxisT, StrxNorm, Strst
        frmParameters.Zaxis.Caption = StrxNorm
        frmParameters.StZaxis.Caption = "*10^" & Strst & " " & UnitName & "^3"
    End If

'    frmParameters.Jaxis.Caption = Format(Jaxis, FormString(Jaxis)) & " " & UnitName & Chr(178) & Chr(215) & " " & UnitName & Chr(178)
'On Error Resume Next
    frmParameters.Show vbModal 'ess
    If frmParameters.Check1.Value = 0 Then
        GrCW.Deleted = True
    Else
        TCWUndoRecordStart hDr, "Add Axis"
        TCWUndoRecordAddGraphic hDr, hGr
        TCWUndoRecordEnd hDr
    End If
    Unload frmParameters

    Set GrAxis = Nothing
    Set GrCW = Nothing
End Sub

Private Sub ClosedGraphicMomentInertiaNewNew(Con As ContGeo, Jx As Double, Jy As Double, S As Double, xc As Double, yc As Double, Jxy As Double)
Dim nDiv0 As Long
    nDiv0 = 1000
    S = 0
    Jx = 0
    Jy = 0
    Jxy = 0
Dim Sx#, Sy#
    Sx = 0
    Sy = 0
Dim i As Long, j As Long
Dim xMax#, yMax#, xMin#, yMin#
    xMax = -10000000
    yMax = -10000000
    xMin = 10000000
    yMin = 10000000
Dim xi#, yi#, xi1#, yi1#
Dim nV As Long
    nV = Con.NVer
    For i = 0 To nV - 1
        xi = Con.xVer(i)
        yi = Con.yVer(i)
        If xi > xMax Then xMax = xi
        If yi > yMax Then yMax = yi
        If xi < xMin Then xMin = xi
        If yi < yMin Then yMin = yi
    Next i
Dim nDiv%
'Define Moment Inertia Jx
Dim xy() As Double
ReDim xy(2 * nDiv0)
Dim xyClear() As Double
ReDim xyClear(nV)

'?????????????????????????????????????????????????????????????????
    nDiv = 0
    For i = 0 To nV - 1
        xy(i) = Con.yVer(i)
    Next i
    xyClear(0) = xy(0)
    nDiv = nDiv + 1
Dim Exist As Boolean
    For i = 0 To nV - 1
        Exist = False
        For j = 0 To nDiv - 1
            If Abs(xy(i) - xyClear(j)) < Eps Then
                Exist = True
                Exit For
            End If
        Next j
        If Exist = False Then
            xyClear(nDiv) = xy(i)
            nDiv = nDiv + 1
        End If
    Next i
Dim xma#, k1%, n1%
'  FILTER BEGIN
        For j = nDiv - 1 To 1 Step -1
            xma = -10000000
            For k1 = 0 To j
                If xyClear(k1) > xma Then
                    xma = xyClear(k1)
                    n1 = k1
                End If
            Next k1
            xyClear(n1) = xyClear(j)
            xyClear(j) = xma
        Next j
'  FILTER END

' Add additional points
Dim nDiv1 As Long
        nDiv1 = 0
        xy(0) = xyClear(0)
        nDiv1 = nDiv1 + 1
        For i = 0 To nDiv - 2
            yi = xyClear(i)
            yi1 = xyClear(i + 1)
            If yi1 - yi < (yMax - yMin) / nDiv0 Then
                xy(nDiv1) = xyClear(i + 1)
                nDiv1 = nDiv1 + 1
            Else
Dim xyCur#
                For xyCur = xyClear(i) + (yMax - yMin) / nDiv0 To xyClear(i + 1) Step (yMax - yMin) / nDiv0
                    xy(nDiv1) = xyCur
                    nDiv1 = nDiv1 + 1
                Next xyCur
            End If
            If xyCur > yi1 Then
                xy(nDiv1 - 1) = xyClear(i + 1)
            Else
                xy(nDiv1) = xyClear(i + 1)
                nDiv1 = nDiv1 + 1
            End If
        Next i

'??????????????????????????????????????????????????????????????????

Dim dy#, yCur#
Dim xx(500) As Double
Dim kInt%
Dim xj#, yj#, xj1#, yj1#
    kInt = 0
    For i = 0 To nDiv1 - 2
        kInt = 0
        dy = xy(i + 1) - xy(i)
        yCur = (xy(i + 1) + xy(i)) / 2
        For j = 0 To nV - 2
            xj = Con.xVer(j)
            yj = Con.yVer(j)
            xj1 = Con.xVer(j + 1)
            yj1 = Con.yVer(j + 1)
            If yj > yCur + Eps And yj1 > yCur + Eps Then GoTo LL
            If yj < yCur - Eps And yj1 < yCur - Eps Then GoTo LL
            If Abs(yj - yCur) < Eps Then GoTo LL
            If Abs(yj1 - yCur) < Eps Then
                xx(kInt) = xj1
                kInt = kInt + 1
                GoTo LL
            End If
            xx(kInt) = xj + (xj1 - xj) * (yCur - yj) / (yj1 - yj)
            kInt = kInt + 1
LL:
        Next j
'  FILTER BEGIN
        For j = kInt - 1 To 1 Step -1
            xma = -10000000
            For k1 = 0 To j
                If xx(k1) > xma Then
                    xma = xx(k1)
                    n1 = k1
                End If
            Next k1
            xx(n1) = xx(j)
            xx(j) = xma
        Next j
'  FILTER END
Dim lx#
        lx = 0
        For j = 0 To kInt - 1 Step 2
            lx = lx + (xx(j + 1) - xx(j))
'            Sx = Sx + (xx(j + 1) - xx(j)) * dy * (xx(j + 1) + xx(j)) / 2
            Sy = Sy + (xx(j + 1) - xx(j)) * dy * yCur
            Jxy = Jxy + (xx(j + 1) - xx(j)) * dy * (xx(j + 1) + xx(j)) / 2 * yCur
        Next j
        S = S + lx * dy
        Jx = Jx + lx * dy * yCur * yCur

    Next i

'#######################################################################
'Define Moment Inertia Jy
'?????????????????????????????????????????????????????????????????
    nDiv = 0
    For i = 0 To nV - 1
        xy(i) = Con.xVer(i)
    Next i
    xyClear(0) = xy(0)
    nDiv = nDiv + 1
    For i = 0 To nV - 1
        Exist = False
        For j = 0 To nDiv - 1
            If Abs(xy(i) - xyClear(j)) < Eps Then
                Exist = True
                Exit For
            End If
        Next j
        If Exist = False Then
            xyClear(nDiv) = xy(i)
            nDiv = nDiv + 1
        End If
    Next i
'  FILTER BEGIN
        For j = nDiv - 1 To 1 Step -1
            xma = -10000000
            For k1 = 0 To j
                If xyClear(k1) > xma Then
                    xma = xyClear(k1)
                    n1 = k1
                End If
            Next k1
            xyClear(n1) = xyClear(j)
            xyClear(j) = xma
        Next j
'  FILTER END
' Add additional points
        nDiv1 = 0
        xy(0) = xyClear(0)
        nDiv1 = nDiv1 + 1
        For i = 0 To nDiv - 2
            xi = xyClear(i)
            xi1 = xyClear(i + 1)
            If xi1 - xi < (xMax - xMin) / nDiv0 Then
                xy(nDiv1) = xyClear(i + 1)
                nDiv1 = nDiv1 + 1
            Else
                For xyCur = xyClear(i) + (xMax - xMin) / nDiv0 To xyClear(i + 1) Step (xMax - xMin) / nDiv0
                    xy(nDiv1) = xyCur
                    nDiv1 = nDiv1 + 1
                Next xyCur
            End If
            If xyCur > xi1 Then
                xy(nDiv1 - 1) = xyClear(i + 1)
            Else
                xy(nDiv1) = xyClear(i + 1)
                nDiv1 = nDiv1 + 1
            End If

        Next i

'??????????????????????????????????????????????????????????????????

   Sx = 0
Dim dx#, xCur#
    kInt = 0
    Eps = 0.000001
    For i = 0 To nDiv1 - 2
        kInt = 0
        dx = xy(i + 1) - xy(i)
        xCur = (xy(i + 1) + xy(i)) / 2
        For j = 0 To nV - 2
            xj = Con.xVer(j)
            yj = Con.yVer(j)
            xj1 = Con.xVer(j + 1)
            yj1 = Con.yVer(j + 1)
            If xj > xCur + Eps And xj1 > xCur + Eps Then GoTo LLL
            If xj < xCur - Eps And xj1 < xCur - Eps Then GoTo LLL
            If Abs(xj - xCur) < Eps Then GoTo LLL
            If Abs(xj1 - xCur) < Eps Then
                xx(kInt) = yj1
                kInt = kInt + 1
                GoTo LLL
            End If
            If Abs(xj1 - xj) < Eps Then GoTo LLL
            xx(kInt) = yj + (yj1 - yj) * (xCur - xj) / (xj1 - xj)
            kInt = kInt + 1
LLL:
        Next j

'  FILTER BEGIN
        For j = kInt - 1 To 1 Step -1
            xma = -10000000
            For k1 = 0 To j
                If xx(k1) > xma Then
                    xma = xx(k1)
                    n1 = k1
                End If
            Next k1
            xx(n1) = xx(j)
            xx(j) = xma
        Next j
'  FILTER END
        lx = 0
        For j = 0 To kInt - 1 Step 2
            lx = lx + (xx(j + 1) - xx(j))
            Sx = Sx + (xx(j + 1) - xx(j)) * dx * xCur
        Next j
        Jy = Jy + lx * dx * xCur * xCur
    Next i

    xc = Sx / S
    yc = Sy / S

'    Grs.AddStar xc, yc, 0
End Sub

Private Function PickAxis(xClick As Double, yClick As Double) As Boolean
    PickAxis = False

Dim PicRes As PickResult
Dim PicCount As Long, i As Long
Dim Gri As Graphic
    Set PicRes = Vi.PickPoint(xClick, yClick, 0.2)
    PicCount = PicRes.Count
    If PicCount = 0 Then
        PickAxis = False
        Exit Function
    End If
    For i = 0 To PicCount - 1
        Set Gri = PicRes(i).Graphic
        If Gri.Type = "GRAPHIC" Then
            If Gri.Vertices.Count = 2 Then
                x0Base = Gri.Vertices(0).x
                y0Base = Gri.Vertices(0).y
                x1Base = Gri.Vertices(1).x
                y1Base = Gri.Vertices(1).y
                PickAxis = True
                Exit Function
            End If
        End If
    Next i

End Function

'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

' For Clicked on Object

Private Function ClickOnObject(xClick As Double, yClick As Double) As Boolean
    Eps = 0.000001
    ClickOnObject = True
Dim PicRes As PickResult
    Set PicRes = Vi.PickPoint(xClick, yClick)
Dim PicCount As Long, i As Long, nV As Long
    PicCount = PicRes.Count
    If PicCount = 0 Then
        Set PicRes = Nothing
'MsgBox "The object is not selected.Please,try selecting it again.", , "Plane Figure Parameters"
        MsgBox "The object is not selected. Please, try to select it again.", vbOKOnly, "Geometric Parameters"

        ClickOnObject = False
        Exit Function
    End If
Dim GrPick As Graphic
    Set GrPick = PicRes(0).Graphic
Dim GrType$
    GrType = GrPick.Type
    If GrType = "TCW70Region" Then GoTo L2
    If GrType = "TCW30POINT" Then GoTo L1
    If GrType = "TCW25DimLin" Then GoTo L1
    If GrType = "TCW25DimDat" Then GoTo L1
    If GrType = "TCW25DimAng" Then GoTo L1
    If GrType = "TCW25DimRad" Then GoTo L1
    If GrType = "TCW25DimDia" Then GoTo L1
    If GrType = "TCW25DimLead" Then GoTo L1
    If GrType = "TC_Multiline" Then GoTo L1

    If GrType = "3DMESH" Then GoTo L1
    If GrType = "TCW40CUBE" Then GoTo L1
    If GrType = "TCW40SPHERE" Then GoTo L1
    If GrType = "TCW40LOFT" Then GoTo L1
    If GrType = "TCW40EXTRUDE" Then GoTo L1
    If GrType = "TCW40SPIN" Then GoTo L1
    If GrType = "TCW60ACISSOLID" Then GoTo L1
    If GrType = "SURFACE" Then GoTo L1

    If GrType = "INSERT" Then GoTo L1
    If GrType = "TCW60Wall" Then GoTo L1
    If GrPick.Unbounded = True Then GoTo L1
    If GrPick.Closed = False Then GoTo L1

    If GrType = "TCW50Polyline" Then
        With GrPick.Vertices
            nV = .Count
            For i = 1 To nV - 1
                If .Item(i).PenDown = False Then
                    GoTo L1
                End If
            Next i
        End With
    End If

L2:
Dim hDrawing As Long
Dim hGraphic As Long
Dim Res%
Dim Res1 As Boolean
    hDrawing = TCWDrawingActive()
    hGraphic = TCWGraphicAt(hDrawing, GrPick.Index)
    hMWorkPlane = GraphicGetMatrix(hGraphic)

Dim GrHatch As Graphic
    Set GrHatch = GrPick.Graphics.AddHatch
    If Dr.Properties("TileMode") = 1 Then
        GrHatch.Properties("Thickness") = 0
    End If
    GrHatch.Properties("PenColor") = RGB(0, 255, 0)
    hGraphic = TCWGraphicAt(hDrawing, GrHatch.Index)
    GraphicSetMatrix hGraphic, hMWorkPlane
    GrHatch.Draw

Dim GrSets As GraphicSets
Dim GrSet As GraphicSet
    Set GrSets = Dr.GraphicSets
    Set GrSet = GrSets.Add
    Call ExplodeWithUnVisible(GrHatch, GrSet)

Dim SetCount As Long
    SetCount = GrSet.Count
Dim NumCont As Long
    NumCont = SetCount
Dim Con() As ContGeo
ReDim Con(NumCont)
Dim j As Long
    For i = 0 To NumCont - 1
        Set Gr = GrSet(i)
        nV = Gr.Vertices.Count
ReDim Con(i).xVer(nV)
ReDim Con(i).yVer(nV)
        Con(i).NVer = nV
        With Gr.Vertices
            For j = 0 To nV - 1
                Con(i).xVer(j) = .Item(j).x
                Con(i).yVer(j) = .Item(j).y
            Next j
        End With
    Next i
Dim xc#, yc#
Dim PointOutside As Boolean
Dim iExt As Long
    iExt = 0
    PointOutside = True

    For i = 0 To NumCont - 1
        xc = Con(i).xVer(0)
        yc = Con(i).yVer(0)
        For j = 0 To NumCont - 1
            If j = i Then GoTo ENDJ
            If PointIntoContour(Con(j), xc, yc) = 0 Then
                PointOutside = True
            Else
                PointOutside = False
            End If
ENDJ:
        Next j
        If PointOutside = True Then
            iExt = i
            Exit For
        End If
    Next i
    GeometryNew Con, NumCont - 1, iExt

    GrHatch.Visible = False
    GrHatch.Draw
    GrHatch.Deleted = True
    GrSet.Clear
    Set GrHatch = Nothing
    Set GrPick = Nothing
    Set PicRes = Nothing
    Set GrSet = Nothing
    Set GrSets = Nothing

   Exit Function
L1:
'    MsgBox "The selection object is not valid for this operation.Please,try selecting it again", , "Plane Figure Parameters"
    MsgBox "Selected object is not valid for operation.", , "Geometric Parameters"

    Set PicRes = Nothing
    Set GrPick = Nothing
    ClickOnObject = False

End Function

Private Sub NumNormalize(x#, StrxNorm$, Strst$)

Dim xx#, st%
    xx = x
    st = 0
    If Abs(x) < Eps Then
        StrxNorm = Format(x, "###0.0000")
        Strst = "0"
        Exit Sub
    End If
    If Abs(x) > 1 - Eps And Abs(x) < 10 - Eps Then
        StrxNorm = Format(x, "###0.0000")
        Strst = CStr(st)
        Exit Sub
    End If

    If Abs(x) > 10 - Eps Then
        For st = 1 To 100
            xx = x / (10 ^ st)
            If Abs(xx) > 1 - Eps And Abs(xx) < 10 - Eps Then
                StrxNorm = Format(xx, "###0.0000")
                Strst = CStr(st)
                Exit Sub
            End If
        Next st
    End If

    If Abs(x) < 1 - Eps Then
        For st = 1 To 100
            xx = x * (10 ^ st)
            If Abs(xx) > 1 - Eps And Abs(xx) < 10 - Eps Then
                StrxNorm = Format(xx, "###0.0000")
                Strst = CStr("-" & st)
                Exit Sub
            End If
        Next st
    End If

End Sub

Public Function MouseMove(WhichDrawing As Drawing, WhichView As View, WhichWindow As Window, Shift As Long, x As Long, y As Long, Cancel As Boolean)
Dim xCurV#, yCurV#, xCurW#, yCurW#

    If Checked(2) = False Then
        If Checked(0) Then
            theToolEvents.ToolChangePrompt Me, "", False
            theToolEvents.ToolChangePrompt Me, "Pick some closed graphic", False
        Else
            theToolEvents.ToolChangePrompt Me, "", False
            theToolEvents.ToolChangePrompt Me, "Pick inside closed area", False
        End If
    Else
        If FirstClick = 0 Then
            theToolEvents.ToolChangePrompt Me, "", False
            theToolEvents.ToolChangePrompt Me, "Pick first point of Axis", False
        End If
        If FirstClick = 1 Then
            WhichView.ScreenToView x, y, xCurV, yCurV
            WhichView.ViewToWorld xCurV, yCurV, 0, xCurW, yCurW, 0
            GrAxis.Visible = False
            GrAxis.Draw
            With GrAxis.Vertices
                .Item(1).x = xCurW
                .Item(1).y = yCurW
            End With
            GrAxis.Visible = True
            GrAxis.Draw

            theToolEvents.ToolChangePrompt Me, "", False
            theToolEvents.ToolChangePrompt Me, "Pick second point of Axis", False
       End If
        If FirstClick = -1 Then
            If Checked(0) Then
                theToolEvents.ToolChangePrompt Me, "", False
                theToolEvents.ToolChangePrompt Me, "Pick some closed graphic", False
            Else
                theToolEvents.ToolChangePrompt Me, "", False
                theToolEvents.ToolChangePrompt Me, "Pick inside closed area", False
            End If

        End If

    End If

 '   theToolEvents.ToolChangePrompt Me, "", False
 '   theToolEvents.ToolChangePrompt Me, LoadResString(121), False
End Function

Private Sub NearestSnapPoint(TempID, xV#, yV#, TypeSnap As Long, xW0#, yW0#)
    Vi.ViewToWorld xV, yV, 0, xW0, yW0, 0

Dim PRes As PickResult
Dim PicCount As Long, i As Long
Dim PEnt As PickEntry
Dim Ver As Vertex
    Set PRes = Vi.PickPoint(xV, yV)

    PicCount = PRes.Count
    If PicCount = 0 Then
        Set PRes = Nothing
        Exit Sub
    End If
Dim xW#, yW#, Dist#, DistMin#
    DistMin = 100000000
Dim iMin As Long
    iMin = -1
    For i = 0 To PicCount - 1
        Set PEnt = PRes(i)
        If PEnt.Graphic.ID <> TempID Then
            Set Ver = PEnt.ClosestVertex
            xW = Ver.x
            yW = Ver.y
            Dist = Sqr((xW0 - xW) ^ 2 + (yW0 - yW) ^ 2)
            If Dist < DistMin Then
                DistMin = Dist
                iMin = i
            End If
        End If
    Next i
    If iMin > -1 Then
        Set Ver = PRes(iMin).ClosestVertex
        xW0 = Ver.x
        yW0 = Ver.y
    End If

    Set Ver = Nothing
    Set PEnt = Nothing
    Set PRes = Nothing
End Sub


Examples - Plane Figure Parameter Tool - Parameters.frm

Parameters.frm

Plane Figure Parameter Tool Example

VERSION 5.00
Begin VB.Form frmParameters
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Geometric Parameters"
   ClientHeight    =   6405
   ClientLeft      =   30
   ClientTop       =   270
   ClientWidth     =   5805
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6405
   ScaleWidth      =   5805
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton CmdOk
      Caption         =   "Ok"
      Height          =   372
      Left            =   3600
      TabIndex        =   56
      Top             =   5880
      Width           =   1212
   End
   Begin VB.ComboBox Units
      Height          =   288
      ItemData        =   "Parameters.frx":0000
      Left            =   600
      List            =   "Parameters.frx":0002
      TabIndex        =   53
      Top             =   6000
      Width           =   972
   End
   Begin VB.Frame Frame8
      Caption         =   "Section Modulus relative Axis"
      Height          =   612
      Left            =   2880
      TabIndex        =   49
      Top             =   5040
      Width           =   2772
      Begin VB.Label StZaxis
         AutoSize        =   -1  'True
         Caption         =   "*10^0 in^3"
         Height          =   192
         Left            =   1680
         TabIndex        =   52
         Top             =   240
         Width           =   720
      End
      Begin VB.Label Zaxis
         BackColor       =   &H8000000E&
         Caption         =   "0.000"
         Height          =   252
         Left            =   840
         TabIndex        =   51
         Top             =   240
         Width           =   732
      End
      Begin VB.Label Label16
         AutoSize        =   -1  'True
         Caption         =   "Zaxis ="
         Height          =   192
         Left            =   240
         TabIndex        =   50
         Top             =   240
         Width           =   504
      End
   End
   Begin VB.Frame Frame7
      Caption         =   "Base Section Modulus"
      Height          =   1092
      Left            =   2760
      TabIndex        =   41
      Top             =   2880
      Width           =   2892
      Begin VB.Label StZyc
         AutoSize        =   -1  'True
         Caption         =   "*10^0 in^3"
         Height          =   192
         Left            =   1800
         TabIndex        =   47
         Top             =   720
         Width           =   720
      End
      Begin VB.Label Zyc
         BackColor       =   &H8000000E&
         Caption         =   "0.000"
         Height          =   252
         Left            =   840
         TabIndex        =   46
         Top             =   720
         Width           =   852
      End
      Begin VB.Label Label14
         AutoSize        =   -1  'True
         Caption         =   "Zyc ="
         Height          =   192
         Left            =   240
         TabIndex        =   45
         Top             =   720
         Width           =   384
      End
      Begin VB.Label StZxc
         AutoSize        =   -1  'True
         Caption         =   "*10^0 in^3"
         Height          =   192
         Left            =   1800
         TabIndex        =   44
         Top             =   240
         Width           =   720
      End
      Begin VB.Label Zxc
         BackColor       =   &H8000000E&
         Caption         =   "0.000"
         Height          =   252
         Left            =   840
         TabIndex        =   43
         Top             =   240
         Width           =   852
      End
      Begin VB.Label Label13
         AutoSize        =   -1  'True
         Caption         =   "Zxc ="
         Height          =   192
         Left            =   240
         TabIndex        =   42
         Top             =   240
         Width           =   372
      End
   End
   Begin VB.Frame Frame6
      Caption         =   "Moment of Inertia relative Axis"
      Height          =   612
      Left            =   120
      TabIndex        =   37
      Top             =   5040
      Width           =   2652
      Begin VB.Label StJaxis
         AutoSize        =   -1  'True
         Caption         =   "*10^0 in^4"
         Height          =   192
         Left            =   1440
         TabIndex        =   40
         Top             =   240
         Width           =   720
      End
      Begin VB.Label Jaxis
         BackColor       =   &H80000009&
         Caption         =   "0.000"
         Height          =   252
         Left            =   720
         TabIndex        =   39
         Top             =   240
         Width           =   612
      End
      Begin VB.Label Label12
         AutoSize        =   -1  'True
         Caption         =   "Jaxis ="
         Height          =   192
         Left            =   120
         TabIndex        =   38
         Top             =   240
         Width           =   492
      End
   End
   Begin VB.Frame Frame5
      Caption         =   " Main Axis"
      Height          =   612
      Left            =   120
      TabIndex        =   24
      Top             =   4200
      Width           =   5532
      Begin VB.CheckBox Check1
         Caption         =   "Add Main Axis"
         Height          =   252
         Left            =   3120
         TabIndex        =   55
         Top             =   240
         Width           =   1572
      End
      Begin VB.Label Label15
         AutoSize        =   -1  'True
         Caption         =   "degrees"
         Height          =   192
         Left            =   1800
         TabIndex        =   48
         Top             =   240
         Width           =   612
      End
      Begin VB.Label Label11
         Caption         =   "Angle ="
         Height          =   252
         Left            =   120
         TabIndex        =   26
         Top             =   240
         Width           =   612
      End
      Begin VB.Label Angle
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         Caption         =   "0.000"
         ForeColor       =   &H80000008&
         Height          =   252
         Left            =   840
         TabIndex        =   25
         Top             =   240
         Width           =   852
      End
   End
   Begin VB.Frame Frame4
      Caption         =   "Radius of Gyration"
      Height          =   1092
      Left            =   2760
      TabIndex        =   17
      Top             =   1680
      Width           =   2892
      Begin VB.Label Stky
         AutoSize        =   -1  'True
         Caption         =   "*10^0 in"
         Height          =   192
         Left            =   1800
         TabIndex        =   36
         Top             =   720
         Width           =   552
      End
      Begin VB.Label Stkx
         AutoSize        =   -1  'True
         Caption         =   "*10^0 in"
         Height          =   192
         Left            =   1800
         TabIndex        =   35
         Top             =   240
         Width           =   552
      End
      Begin VB.Label Label9
         AutoSize        =   -1  'True
         Caption         =   "Ky ="
         Height          =   192
         Left            =   240
         TabIndex        =   21
         Top             =   720
         Width           =   300
      End
      Begin VB.Label kx
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         Caption         =   "0.000"
         ForeColor       =   &H80000008&
         Height          =   252
         Left            =   840
         TabIndex        =   20
         Top             =   240
         Width           =   852
      End
      Begin VB.Label ky
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         Caption         =   "0.000"
         ForeColor       =   &H80000008&
         Height          =   252
         Left            =   840
         TabIndex        =   19
         Top             =   720
         Width           =   852
      End
      Begin VB.Label Label7
         AutoSize        =   -1  'True
         Caption         =   "Kx ="
         Height          =   192
         Left            =   240
         TabIndex        =   18
         Top             =   240
         Width           =   288
      End
   End
   Begin VB.Frame Frame3
      Caption         =   "Base Moments of Inertia"
      Height          =   2292
      Left            =   120
      TabIndex        =   8
      Top             =   1680
      Width           =   2532
      Begin VB.Label StJp
         AutoSize        =   -1  'True
         Caption         =   "*10^0 in^4"
         Height          =   192
         Left            =   1440
         TabIndex        =   32
         Top             =   1800
         Width           =   720
      End
      Begin VB.Label StJxyc
         AutoSize        =   -1  'True
         Caption         =   "*10^0 in^4"
         Height          =   192
         Left            =   1440
         TabIndex        =   31
         Top             =   1320
         Width           =   720
      End
      Begin VB.Label StJyc
         AutoSize        =   -1  'True
         Caption         =   "*10^0 in^4"
         Height          =   192
         Left            =   1440
         TabIndex        =   30
         Top             =   840
         Width           =   720
      End
      Begin VB.Label StJxc
         AutoSize        =   -1  'True
         Caption         =   "*10^0 in^4"
         Height          =   192
         Left            =   1440
         TabIndex        =   29
         Top             =   360
         Width           =   720
      End
      Begin VB.Label Label10
         AutoSize        =   -1  'True
         Caption         =   "Jxyc ="
         Height          =   192
         Left            =   120
         TabIndex        =   23
         Top             =   1320
         Width           =   444
      End
      Begin VB.Label Jxyc
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         Caption         =   "0.000"
         ForeColor       =   &H80000008&
         Height          =   252
         Left            =   600
         TabIndex        =   22
         Top             =   1320
         Width           =   732
      End
      Begin VB.Label Label6
         AutoSize        =   -1  'True
         Caption         =   "Jp ="
         Height          =   192
         Left            =   120
         TabIndex        =   14
         Top             =   1800
         Width           =   300
      End
      Begin VB.Label Jp
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         Caption         =   "0.000"
         ForeColor       =   &H80000008&
         Height          =   252
         Left            =   600
         TabIndex        =   13
         Top             =   1800
         Width           =   732
      End
      Begin VB.Label Jyc
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         Caption         =   "0.000"
         ForeColor       =   &H80000008&
         Height          =   252
         Left            =   600
         TabIndex        =   12
         Top             =   840
         Width           =   732
      End
      Begin VB.Label Label4
         AutoSize        =   -1  'True
         Caption         =   "Jyc ="
         Height          =   192
         Left            =   120
         TabIndex        =   11
         Top             =   840
         Width           =   372
      End
      Begin VB.Label Jxc
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         Caption         =   "0.000"
         ForeColor       =   &H80000008&
         Height          =   252
         Left            =   600
         TabIndex        =   10
         Top             =   360
         Width           =   732
      End
      Begin VB.Label Label5
         AutoSize        =   -1  'True
         Caption         =   "Jxc ="
         Height          =   192
         Left            =   120
         TabIndex        =   9
         Top             =   360
         Width           =   360
      End
   End
   Begin VB.Frame Frame2
      Caption         =   "Area"
      Height          =   1332
      Left            =   2760
      TabIndex        =   5
      Top             =   120
      Width           =   2892
      Begin VB.Label StAreaHoles
         AutoSize        =   -1  'True
         Caption         =   "*10^0 in^2"
         Height          =   192
         Left            =   1800
         TabIndex        =   34
         Top             =   840
         Width           =   720
      End
      Begin VB.Label StAreaFull
         AutoSize        =   -1  'True
         Caption         =   "*10^0 in^2"
         Height          =   192
         Left            =   1800
         TabIndex        =   33
         Top             =   360
         Width           =   720
      End
      Begin VB.Label Label8
         AutoSize        =   -1  'True
         Caption         =   "A(Holes)="
         Height          =   192
         Left            =   120
         TabIndex        =   16
         Top             =   840
         Width           =   720
      End
      Begin VB.Label AreaHoles
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         Caption         =   "0.000"
         ForeColor       =   &H80000008&
         Height          =   252
         Left            =   960
         TabIndex        =   15
         Top             =   840
         Width           =   732
      End
      Begin VB.Label AreaFull
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         Caption         =   "0.000"
         ForeColor       =   &H80000008&
         Height          =   252
         Left            =   960
         TabIndex        =   7
         Top             =   360
         Width           =   732
      End
      Begin VB.Label Label3
         AutoSize        =   -1  'True
         Caption         =   "A(Full) ="
         Height          =   192
         Left            =   120
         TabIndex        =   6
         Top             =   360
         Width           =   576
      End
   End
   Begin VB.Frame Frame1
      Caption         =   "Center of Gravity"
      Height          =   1332
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2532
      Begin VB.Label Styc
         AutoSize        =   -1  'True
         Caption         =   "*10^0 in"
         Height          =   192
         Left            =   1440
         TabIndex        =   28
         Top             =   840
         Width           =   552
      End
      Begin VB.Label Stxc
         AutoSize        =   -1  'True
         Caption         =   "*10^0 in"
         Height          =   192
         Left            =   1440
         TabIndex        =   27
         Top             =   360
         Width           =   552
      End
      Begin VB.Label yc
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         Caption         =   "0.000"
         ForeColor       =   &H80000008&
         Height          =   252
         Left            =   600
         TabIndex        =   4
         Top             =   840
         Width           =   732
      End
      Begin VB.Label Label2
         AutoSize        =   -1  'True
         Caption         =   "yc = "
         Height          =   192
         Left            =   120
         TabIndex        =   3
         Top             =   840
         Width           =   324
      End
      Begin VB.Label xc
         Appearance      =   0  'Flat
         BackColor       =   &H80000005&
         Caption         =   "0.000"
         ForeColor       =   &H80000008&
         Height          =   252
         Left            =   600
         TabIndex        =   2
         Top             =   360
         Width           =   732
      End
      Begin VB.Label Label1
         AutoSize        =   -1  'True
         Caption         =   "xc ="
         Height          =   192
         Left            =   120
         TabIndex        =   1
         Top             =   360
         Width           =   276
      End
   End
   Begin VB.Label Label17
      AutoSize        =   -1  'True
      Caption         =   "Units of measurement"
      Height          =   192
      Left            =   360
      TabIndex        =   54
      Top             =   5760
      Width           =   1548
   End
End
Attribute VB_Name = "frmParameters"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public UnitOld$
Private Sub Form_Load()
    UnitOld = DrUnit
    Units.AddItem "in"
    Units.AddItem "ft"
    Units.AddItem "yd"
    Units.AddItem "mm"
    Units.AddItem "cm"
    Units.AddItem "m"
End Sub

Private Sub cmdOk_Click()
    Me.Hide
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then Me.Hide
End Sub

Private Sub NumNormalize1(x#, StrxNorm$, Strst$)

Dim xx#, st%
    xx = x
    st = 0

    If Abs(x) > 1 - Eps And Abs(x) < 10 - Eps Then
        StrxNorm = Format(x, "###0.0000")
        Strst = CStr(st)
        Exit Sub
    End If

    If Abs(x) > 10 - Eps Then
        For st = 1 To 100
            xx = x / (10 ^ st)
            If Abs(xx) > 1 - Eps And Abs(xx) < 10 - Eps Then
                StrxNorm = Format(xx, "###0.0000")
                Strst = CStr(st)
                Exit Sub
            End If
        Next st
    End If

    If Abs(x) < 1 - Eps Then
        For st = 1 To 100
            xx = x * (10 ^ st)
            If Abs(xx) > 1 - Eps And Abs(xx) < 10 - Eps Then
                StrxNorm = Format(xx, "###0.0000")
                Strst = CStr("-" & st)
                Exit Sub
            End If
        Next st
    End If

End Sub

Private Sub Units_Click()
Dim UnitNew$
Dim ScaleUnits#

    UnitNew = frmParameters.Units.Text
    ScaleUnits = UnitToUnit(UnitNew, DrUnit)
'    UnitOld = UnitNew

Dim StrxNorm$, Strst$
'MsgBox ("UnitNew = " & UnitNew & " DrUnit = " & DrUnit)
'MsgBox ("xc=" & CStr(xcT) & "  ScaleUnits=" & CStr(ScaleUnits))
    NumNormalize1 xcT * ScaleUnits, StrxNorm, Strst
    frmParameters.xc.Caption = StrxNorm
    frmParameters.Stxc.Caption = "*10^" & Strst & " " & UnitNew
'MsgBox ("xc=" & CStr(xcT))
    NumNormalize1 ycT * ScaleUnits, StrxNorm, Strst
    frmParameters.yc.Caption = StrxNorm
    frmParameters.Styc.Caption = "*10^" & Strst & " " & UnitNew

    NumNormalize1 S0T * ScaleUnits ^ 2, StrxNorm, Strst
    frmParameters.AreaFull.Caption = StrxNorm
    frmParameters.StAreaFull.Caption = "*10^" & Strst & " " & UnitNew & "^2"

    NumNormalize1 SIntT * ScaleUnits ^ 2, StrxNorm, Strst
    frmParameters.AreaHoles.Caption = StrxNorm
    frmParameters.StAreaHoles.Caption = "*10^" & Strst & " " & UnitNew & "^2"

    NumNormalize1 JxcT * ScaleUnits ^ 4, StrxNorm, Strst
    frmParameters.Jxc.Caption = StrxNorm
    frmParameters.StJxc.Caption = "*10^" & Strst & " " & UnitNew & "^4"

    NumNormalize1 JycT * ScaleUnits ^ 4, StrxNorm, Strst
    frmParameters.Jyc.Caption = StrxNorm
    frmParameters.StJyc.Caption = "*10^" & Strst & " " & UnitNew & "^4"

    NumNormalize1 JxycT * ScaleUnits ^ 4, StrxNorm, Strst
    frmParameters.Jxyc.Caption = StrxNorm
    frmParameters.StJxyc.Caption = "*10^" & Strst & " " & UnitNew & "^4"

    NumNormalize1 JpT * ScaleUnits ^ 4, StrxNorm, Strst
    frmParameters.Jp.Caption = StrxNorm
    frmParameters.StJp.Caption = "*10^" & Strst & " " & UnitNew & "^4"

    NumNormalize1 KxT * ScaleUnits, StrxNorm, Strst
    frmParameters.kx.Caption = StrxNorm
    frmParameters.Stkx.Caption = "*10^" & Strst & " " & UnitNew

    NumNormalize1 KyT * ScaleUnits, StrxNorm, Strst
    frmParameters.ky.Caption = StrxNorm
    frmParameters.Stky.Caption = "*10^" & Strst & " " & UnitNew

    NumNormalize1 WxcT * ScaleUnits ^ 3, StrxNorm, Strst
    frmParameters.Zxc.Caption = StrxNorm
    frmParameters.StZxc.Caption = "*10^" & Strst & " " & UnitNew & "^3"

    NumNormalize1 WycT * ScaleUnits ^ 3, StrxNorm, Strst
    frmParameters.Zyc.Caption = StrxNorm
    frmParameters.StZyc.Caption = "*10^" & Strst & " " & UnitNew & "^3"

    NumNormalize1 JaxisT * ScaleUnits ^ 4, StrxNorm, Strst
    frmParameters.Jaxis.Caption = StrxNorm
    frmParameters.StJaxis.Caption = "*10^" & Strst & " " & UnitNew & "^4"

    NumNormalize1 WaxisT * ScaleUnits ^ 3, StrxNorm, Strst
    frmParameters.Zaxis.Caption = StrxNorm
    frmParameters.StZaxis.Caption = "*10^" & Strst & " " & UnitNew & "^3"

End Sub

Private Function UnitToUnit(UnitName As String, UnitNameOld As String) As Double
    UnitToUnit = 1

    If UnitNameOld = "in" Or UnitNameOld = """" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 1
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 1 / 12
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 1 / 36
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 1 / (12 * 5280)
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 25.4
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 2.54
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 2.54 / 100
            Exit Function
        End If
    End If

    If UnitNameOld = "ft" Or UnitNameOld = "'" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 12
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 1
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 1 / 3
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 1 / 5280
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 12 * 25.4
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 12 * 2.54
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 12 * 2.54 / 100
            Exit Function
        End If
    End If

     If UnitNameOld = "yd" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 3 * 12
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 3
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 1
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 1 / 5280 / 3
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 3 * 12 * 25.4
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 3 * 12 * 2.54
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 3 * 12 * 2.54 / 100
            Exit Function
        End If
    End If
' Add Miles

      If UnitNameOld = "mm" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 1 / 25.4
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 12 / 25.4
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 3 * 12 / 25.4
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 5280 * 12 / 25.4
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 1
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 1 / 10
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 1 / 1000
            Exit Function
        End If
    End If

       If UnitNameOld = "cm" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 1 / 2.54
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 12 / 2.54
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 3 * 12 / 2.54
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 5280 * 12 / 2.54
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 10
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 1
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 1 / 100
            Exit Function
        End If
    End If

       If UnitNameOld = "m" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 100 / 2.54
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 1200 / 2.54
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 3 * 1200 / 2.54
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 5280 * 1200 / 2.54
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 1000
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 100
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 1
            Exit Function
        End If
    End If
    UnitToUnit = 1

End Function


Examples - Surveyor Dimension Tool - SurvTool.bas

SurvTool.bas

Surveyor Dimension Tool Example

Attribute VB_Name = "modSurvTool"
Option Explicit
Type GrInfo
    nV As Long
    xVer() As Double
    yVer() As Double
End Type

Global objApp As XApplication
Global Drs As Drawings
Global ActDr As Drawing
Global Grs As Graphics
Global Vis As Views
Global Vi As View

Global Const Pi = 3.14159265359
Global Const Eps = 0.000001

Sub Main()
End Sub


Examples - Surveyor Dimension Tool - SurvTool.cls

SurvTool.cls

Surveyor Dimension Tool Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "InsertTool"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'Number of tools in this server
Const NUM_TOOLS = 1

' *******************************************************************
'    Const EventMask = 268435456 + 536870912
'    Const EventMask = 1024 + 268435456 + 536870912
    Const EventMask = 1 + 2 + 4 + 8 + 16 + 32 + 64 + 1024 + 4096 + 262144 + 268435456 + 536870912

    Private iConnectId As Long
    Private iActTool As Long
    Private theToolEvents As IToolEvents

' *******************************************************************
'Toggle this to test loading buttons from .Bmp/.Res
Const boolLoadFromBmp As Boolean = False
Const boolDebug As Boolean = False
'##########################################################################
'##########################################################################
Private Declare Function TCWUndoClear Lib "TCAPI70.dll" () As Long
Private Declare Function TCWUndoRecordEnd Lib "TCAPI70.dll" (ByVal d As Long) As Long
Private Declare Function TCWUndoRecordStart Lib "TCAPI70.dll" (ByVal d As Long, ByRef Title As String) As Long
Private Declare Function TCWUndoRecordAddGraphic Lib "TCAPI70.dll" (ByVal d As Long, ByVal g As Long) As Long
Private Declare Function TCWUndo Lib "TCAPI70.dll" (ByVal N As Long) As Long

Private Declare Function TCWDrawingActive Lib "TCAPI70.dll" () As Long
Private Declare Function TCWGraphicAt Lib "TCAPI70.dll" (ByVal d As Long, ByVal Index As Long) As Long
Private Declare Function TCWVertexAt Lib "TCAPI70.dll" (ByVal g As Long, ByVal Index As Long) As Long

Private Declare Sub prVertexSetSomeFlags Lib "DBAPI70.dll" (ByVal hVer As Long, ByVal FlagOn As Long, ByVal FlagOff As Long)

Private Declare Function GraphicGetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long) As Long
Private Declare Function GraphicSetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long, ByVal hMat As Long) As Boolean
Private Declare Function MatrixEqual Lib "DBAPI70.dll" (ByVal hM1 As Long, ByVal hM2 As Long) As Boolean

Private Declare Function TCWViewRedraw Lib "TCAPI70.dll" () As Long

Private hDr As Long
Private GrCon As Graphic

'Copy a windows bitmap of the requested size to the clipboard
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire bitmap:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono bitmap should be 1-bit (black or white)
Public Function CopyBitmap(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Boolean
    On Error GoTo BitmapError

    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        'Put the image on the Windows clipboard
        Clipboard.SetData TheImage, vbCFDIB
        CopyBitmap = True
        Exit Function
    End If

BitmapError:
    CopyBitmap = False
End Function

'Return a Picture object for the requested size
'Apparently, returning references to StdPicture objects doesn't work for .EXE servers
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire image:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono image should be 1-bit (black or white)
Public Function GetPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Object
    On Error GoTo PictureError

    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        Set GetPicture = TheImage
        Exit Function
    End If

PictureError:
    Set GetPicture = Nothing
End Function

'Implementation specific stuff
'Private function to return the bitmap from .Res file or .Bmp file
Private Function GetButtonPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean, TheImage As StdPicture) As Boolean
    On Error GoTo LoadError

    'There are two ways to load images:  from .Bmp file(s) or from .RES resource.
    'In this demo, we control the loading by a private variable.

    'Note that if you are loading from .Bmp, or if you are running this tool as a
    '.VBP for debugging, you must place the .Res or .Bmp files in the Draggers subdirectory
    'of the directory in which TCW40.EXE (or IMSIGX40.DLL) is located.

    If boolLoadFromBmp Then
        'Load from .Bmp file
        Dim strFileName As String 'File name of .Bmp file to load

        If LargeImage Then
            strFileName = App.Path & "\button24.bmp"
        Else
            strFileName = App.Path & "\button16.bmp"
        End If
        Set TheImage = LoadPicture(strFileName)
    Else
        'Load from .Res file
        Dim idBitmap%  'BITMAP resource id in .Res file

        If LargeImage Then
            idBitmap% = 1002
        Else
            idBitmap% = 1001
        End If
        Set TheImage = LoadResPicture(idBitmap%, vbResBitmap)
    End If

    'Return the image
    GetButtonPicture = True
    Exit Function

LoadError:
    If boolDebug Then
'        MsgBox "Error loading bitmap: " & Err.Description
    End If
    GetButtonPicture = False
End Function

'##########################################################################
'##########################################################################
'##########################################################################

'Return a description string for this package of tools
Public Property Get Description() As String
    Description = "SurvCoordTool"
End Property

'Called to perform tool function
Public Function Run(ByVal Tool As Object) As Boolean
    On Error GoTo ErrorHandler
Dim theXTool As Tool
    Set theXTool = Tool
'    theXTool.Application.ActiveDrawing.Graphics.Unselect

    Set GrCon = Nothing
    If iConnectId <> -1 Then
        objApp.DisconnectEvents iConnectId
        AddLM False
        iConnectId = -1
        iActTool = -1
        theToolEvents.ToolChangePrompt Me, "", False
    Else
        theToolEvents.ToolChangePrompt Me, "", False
        iConnectId = objApp.ConnectEvents(Me, EventMask)
        iActTool = theXTool.Index
        AddLM True
        theToolEvents.ToolChangePrompt Me, "Click on some graphic", False
    End If

    Exit Function
ErrorHandler:
'    MsgBox Err.Msg
    Call Finish
End Function

'Fill arrays with information about tools in the package
'Return the number of tools in the package
Public Function GetToolInfo(CommandNames As Variant, MenuCaptions As Variant, StatusPrompts As Variant, _
    ToolTips As Variant, Enabled As Variant, WantsUpdates As Variant) As Long

    ReDim CommandNames(NUM_TOOLS)
    ReDim MenuCaptions(NUM_TOOLS)
    ReDim StatusPrompts(NUM_TOOLS)
    ReDim ToolTips(NUM_TOOLS)
    ReDim Enabled(NUM_TOOLS)
    ReDim WantsUpdates(NUM_TOOLS)
    CommandNames(0) = "SDK|SurveourCoordinate"
    MenuCaptions(0) = "&SurveourCoordinate"
    ToolTips(0) = "SurveourCoordinate"
    Enabled(0) = True
    WantsUpdates(0) = False
    GetToolInfo = NUM_TOOLS
End Function

'Returns true if tool is correctly initialized
Public Function Initialize(ByVal Tool As Object) As Boolean
On Error GoTo ErrorHandler
    Set objApp = Tool.Application
    Set theToolEvents = objApp
    iConnectId = -1
    iActTool = -1
    Initialize = True
    Exit Function
ErrorHandler:
 '   MsgBox Err.Description
End Function

'Returns true if tool is correctly initialized
Public Function UpdateToolStatus(ByVal Tool As Object, Enabled As Boolean, Checked As Boolean) As Boolean
    Enabled = True 'Could do a test here to determine whether to disable the button/menu item
    If iConnectId = -1 Then
        Checked = False  'Could do a test here to determine whether to check the button/menu item
    Else
        Checked = True
    End If
    UpdateToolStatus = True
End Function

Public Function RunTool(WhichTool As Tool)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function

Public Function BeforeExit(WhichApplication As Application, Cancel As Boolean)
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    Call Finish

End Function
Public Function DrawingNew(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False

    Call Finish
End Function
Public Function DrawingOpen(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function
Public Function DrawingActivate(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function
Public Function DrawingDeactivate(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function
Public Function DrawingBeforeClose(WhichDrawing As Drawing, Cancel As Boolean)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function
Public Function DrawingBeforeSave(WhichDrawing As Drawing, SaveAs As Boolean, Cancel As Boolean)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    Call Finish
End Function

Public Function MouseDown(WhichDrawing As Drawing, WhichView As View, WhichWindow As Window, Button As ImsiMouseButton, Shift As Long, x As Long, y As Long, Cancel As Boolean)
Dim xView#, yView#
On Error GoTo ErrorHandler
    Set Drs = objApp.Drawings
    Set ActDr = WhichDrawing
    Set Grs = ActDr.Graphics
    Set Vis = ActDr.Views
    Set Vi = WhichView
    hDr = TCWDrawingActive
Dim Res As Boolean
    Vi.ScreenToView x, y, xView, yView

    If Button = imsiLeftButton Then
        Cancel = True
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        Res = SelectCurve(xView, yView)
        If Res = False Then
MsgBox "The selection object is not valid for this operation.", , "Surveour Dimension"
            theToolEvents.ToolChangePrompt Me, "", False
            theToolEvents.ToolChangePrompt Me, "Click on some graphic", False
            Exit Function
        End If
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

        If iConnectId <> -1 Then
            theToolEvents.ToolChangePrompt Me, "", False
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
            AddLM False
        End If
        Cancel = True
        Call Finish
    Else
        Cancel = False
    End If
'    Call Finish
    Exit Function
ErrorHandler:
    If iConnectId <> -1 Then
        theToolEvents.ToolChangePrompt Me, "", False
        objApp.DisconnectEvents iConnectId
        iConnectId = -1
        AddLM False
    End If
    Call Finish
 '   MsgBox Err.Description
End Function

Public Function Cancel(DoItPlease As Boolean, CanCancel As Boolean)
    If (DoItPlease) Then
        If iConnectId <> -1 Then
            theToolEvents.ToolChangePrompt Me, "", False
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
        End If

        theToolEvents.ToolChangePrompt Me, "", False
        Call Finish
    End If

    CanCancel = True
End Function

Public Function UpdateUndo(AllowsUndo As Boolean)
    AllowsUndo = False
End Function

Private Function AddActToolLM(iTool As Long, bAdd As Boolean)
'    AddLM bAdd
End Function
Private Sub Class_Terminate()
    If (Not theToolEvents Is Nothing) Then
        Set theToolEvents = Nothing
    End If
    If (Not objApp Is Nothing) Then
        Set objApp = Nothing
    End If

End Sub

Private Function AddLM(bAdd As Boolean)
Dim Captions(0 To 0) As String
Dim Prompts(0 To 0) As String
Dim Enabled(0 To 0) As Boolean
Dim Checked(0 To 0) As Boolean

Dim varCaptions As Variant
Dim varPrompts As Variant
Dim varEnabled As Variant
Dim varChecked As Variant

    If (bAdd) Then
        Captions(0) = "Finish TextAlongCurve"
        Prompts(0) = "Finish TextAlongCurve"
        Enabled(0) = True
        Checked(0) = False
        varCaptions = Captions
        varPrompts = Prompts
        varEnabled = Enabled
        varChecked = Checked

        theToolEvents.ToolChangeCommands Me, 1, varCaptions, varPrompts, varEnabled, varChecked, True
    Else
        theToolEvents.ToolChangeCommands Me, 0, , , , , False
    End If
End Function

Public Function DoLMCommand(CmdInd As Long)
'MsgBox ("CmdInd=" & CStr(CmdInd))
   If CmdInd = 0 Then
         If iConnectId <> -1 Then
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
            AddLM False
        End If
        theToolEvents.ToolChangePrompt Me, "", False

        Call Finish
'        Set objApp = Nothing

    End If

End Function
Private Sub Finish()
    Set GrCon = Nothing
    Set Grs = Nothing
    Set Vi = Nothing
    Set Vis = Nothing
    Set ActDr = Nothing
    Set Drs = Nothing
 '   Set objApp = Nothing
End Sub

'########################################################################
'########################################################################
'########################################################################
' Select Curve at Mouse click

Private Function SelectCurve(xCl As Double, yCl As Double) As Boolean
On Error GoTo ErrorHandler

Dim PicRes As PickResult
Dim PicCount As Long
    ActDr.Application.SnapModes = 256 ' Nearest to graphic
    Set PicRes = Vi.PickPoint(xCl, yCl, 0.2)
    PicCount = PicRes.Count

    If PicCount = 0 Then
        ActDr.Application.SnapModes = 1 ' Nearest to graphic
        SelectCurve = False
        Exit Function
    End If

    Set GrCon = PicRes(0).Graphic
Dim GrConType$, GrConID As Long
    GrConType = GrCon.Type
    If GrConType = "GRAPHIC" Or GrConType = "ARC" Or GrConType = "TCW50Polyline" Then
        GrConID = GrCon.ID
    Else
        ActDr.Application.SnapModes = 1 ' Nearest to graphic
        SelectCurve = False
        Set PicRes = Nothing
        Exit Function
    End If

    If GrConType = "GRAPHIC" And GrCon.Graphics.Count > 0 Then
        ActDr.Application.SnapModes = 1 ' Nearest to graphic
        SelectCurve = False ' Clicked graphic can't take part in operation
        Set PicRes = Nothing
        Exit Function
    End If
    If GrConType = "GRAPHIC" And ActDr.Properties("TileMode") = 1 Then
Dim Thick1#
        Thick1 = -1000000#
        On Error Resume Next
        Thick1 = GrCon.Properties("Thickness")
        If Thick1 = -1000000 Then ' For 3D-Polyline
            ActDr.Application.SnapModes = 1 ' Nearest to graphic
            SelectCurve = False ' Clicked graphic can't take part in operation
            Set PicRes = Nothing
            Exit Function
        End If
    End If
    If GrConType = "TCW50Polyline" Then
'MsgBox (GrCon.Graphics(0).Name)
        If GrCon.Graphics(0).Name = "ChildWithWidth" Or GrCon.Graphics(0).Name = "Line_Width_Cosmetic" Then
            ActDr.Application.SnapModes = 1 ' Nearest to graphic
            SelectCurve = False ' Clicked graphic can't take part in operation
            Set PicRes = Nothing
            Exit Function
        End If
    End If
    If ActDr.Properties("TileMode") = 1 Then
        Thick1 = GrCon.Properties("Thickness")
        If Thick1 <> 0 Then
            ActDr.Application.SnapModes = 1 ' Nearest to graphic
            SelectCurve = False ' Clicked graphic can't take part in operation
            Set PicRes = Nothing
            Exit Function
        End If
    End If

Dim GrText As Graphic
    Set GrText = Grs.Add(, "Surveying.CoordReg")
Dim hGrText As Long
    hGrText = TCWGraphicAt(hDr, GrText.Index)
    TCWUndoRecordStart hDr, "Add Surveour Coordinate"
    TCWUndoRecordAddGraphic hDr, hGrText
    TCWUndoRecordEnd hDr

Dim hGrCon As Long, hMat As Long
    hGrCon = TCWGraphicAt(hDr, GrCon.Index)
    hMat = GraphicGetMatrix(hGrCon)
    GraphicSetMatrix hGrText, hMat

Dim xPic#, yPic#
Dim Ver As Vertex
        Set Ver = PicRes(0).ClosestVertex
        xPic = Ver.x
        yPic = Ver.y

Dim nV As Long, i As Long
Dim xi#, yi#, xi1#, yi1#
Dim l#, sina#, cosa#
Dim xLoc#, yLoc#
Dim iPrev As Long
    iPrev = 0
    If GrConType = "GRAPHIC" Then
        nV = GrCon.Vertices.Count
        If nV = 2 Then
            GrText.Properties("ConVertex") = 0
        Else
            With GrCon.Vertices
                For i = 0 To nV - 2
                    xi = .Item(i).x
                    yi = .Item(i).y
                    xi1 = .Item(i + 1).x
                    yi1 = .Item(i + 1).y
                    l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                    sina = (yi1 - yi) / l
                    cosa = (xi1 - xi) / l
                    yLoc = (yPic - yi) * cosa - (xPic - xi) * sina
                    xLoc = (yPic - yi) * sina + (xPic - xi) * cosa
                    If xLoc > 0 And xLoc < l And Abs(yLoc) < Eps Then
                        iPrev = i
                        Exit For
                    End If
                Next i
            End With
            GrText.Properties("ConVertex") = iPrev
        End If
    End If
    If GrConType = "ARC" Then
        GrText.Properties("ConVertex") = 0
    End If

'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
    If GrConType = "TCW50Polyline" Then
        iPrev = PreviousVertex(GrConType, GrCon, xPic, yPic)
'MsgBox ("iPrev=" & CStr(iPrev))

        GrText.Properties("ConVertex") = iPrev
    End If
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
'$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

    GrText.Properties("GrConID") = GrConID
    GrText.Properties("GrConType") = GrConType
    GrText.Update
    ActDr.Application.SnapModes = 1 ' Nearest to graphic

Dim TSets As TieSets
    Set TSets = ActDr.TieSets
    TSets.Add "Surveying.CoordTie", GrCon, GrText, iPrev, 0

    GrText.Draw
    Set GrText = Nothing
    Set PicRes = Nothing
    Set TSets = Nothing
    SelectCurve = True

    Exit Function
ErrorHandler:
    Set GrText = Nothing
    Set PicRes = Nothing
    Set TSets = Nothing
    SelectCurve = False
    ActDr.Application.SnapModes = 1 ' Nearest to graphic

End Function

' Define number of previous vertices for Base graphic

Private Function PreviousVertex(GrConType As String, GrCon As Graphic, xPic As Double, yPic As Double)

Dim i As Long
Dim nVCon As Long
        nVCon = GrCon.Vertices.Count
Dim nVCosm As Long
        nVCosm = GrCon.Graphics(0).Vertices.Count

Dim GrConInfo As GrInfo
        GrConInfo.nV = nVCon
ReDim GrConInfo.xVer(nVCon)
ReDim GrConInfo.yVer(nVCon)
Dim ArcCount As Long
Dim iBaseArcBeg(100) As Long
Dim iBaseArcEnd(100) As Long
        ArcCount = 0
        With GrCon.Vertices
            For i = 0 To nVCon - 1
                GrConInfo.xVer(i) = .Item(i).x
                GrConInfo.yVer(i) = .Item(i).y
            Next i
            For i = 0 To nVCon - 2
                If .Item(i).Bulge = False And .Item(i + 1).Bulge = True Then
                    iBaseArcBeg(ArcCount) = i
                    iBaseArcEnd(ArcCount) = i + 3
                    ArcCount = ArcCount + 1
                End If
            Next i
        End With

Dim GrCosmInfo As GrInfo
        GrCosmInfo.nV = nVCosm
ReDim GrCosmInfo.xVer(nVCosm)
ReDim GrCosmInfo.yVer(nVCosm)
        With GrCon.Graphics(0).Vertices
            For i = 0 To nVCosm - 1
                GrCosmInfo.xVer(i) = .Item(i).x
                GrCosmInfo.yVer(i) = .Item(i).y
            Next i
        End With

Dim iCosmArcBeg(100) As Long
Dim iCosmArcEnd(100) As Long
Dim j As Long, xi#, yi#, xj#, yj#

        For i = 0 To ArcCount - 1
            xi = GrConInfo.xVer(iBaseArcBeg(i))
            yi = GrConInfo.yVer(iBaseArcBeg(i))
            For j = 0 To nVCosm - 1
                xj = GrCosmInfo.xVer(j)
                yj = GrCosmInfo.yVer(j)
                If Abs(xi - xj) < Eps And Abs(yi - yj) < Eps Then
                    iCosmArcBeg(i) = j
                    Exit For
                End If
            Next j

            xi = GrConInfo.xVer(iBaseArcEnd(i))
            yi = GrConInfo.yVer(iBaseArcEnd(i))
            For j = 0 To nVCosm - 1
                xj = GrCosmInfo.xVer(j)
                yj = GrCosmInfo.yVer(j)
                If Abs(xi - xj) < Eps And Abs(yi - yj) < Eps Then
                    iCosmArcEnd(i) = j
                    Exit For
                End If
            Next j
        Next i

Dim xi1#, yi1#
Dim l#, sina#, cosa#
Dim xLoc#, yLoc#
Dim iPrevCosm As Long, iPrev As Long
Dim yLocMin#
    yLocMin = 10000000

' define number of segment of the  Arc cosmetic graphic
        For i = 0 To nVCosm - 2
            xi = GrCosmInfo.xVer(i)
            yi = GrCosmInfo.yVer(i)
            xi1 = GrCosmInfo.xVer(i + 1)
            yi1 = GrCosmInfo.yVer(i + 1)
            l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
            sina = (yi1 - yi) / l
            cosa = (xi1 - xi) / l
            yLoc = (yPic - yi) * cosa - (xPic - xi) * sina
            xLoc = (yPic - yi) * sina + (xPic - xi) * cosa
            If xLoc > 0 And xLoc < l Then
                If Abs(yLoc) < yLocMin Then
                    iPrevCosm = i
                    yLocMin = Abs(yLoc)
                End If
            End If
        Next i

        iPrev = -1
        For i = 0 To ArcCount - 1
            If iPrevCosm > iCosmArcBeg(i) And iPrevCosm < iCosmArcEnd(i) Then
                iPrev = iBaseArcBeg(i)
            End If
        Next i

        If iPrev = -1 Then
            yLocMin = 10000000

' define number of segment of the  Arc cosmetic graphic
            For i = 0 To nVCon - 2
                xi = GrConInfo.xVer(i)
                yi = GrConInfo.yVer(i)
                xi1 = GrConInfo.xVer(i + 1)
                yi1 = GrConInfo.yVer(i + 1)
                l = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                If Abs(l) < Eps Then GoTo WWW
                sina = (yi1 - yi) / l
                cosa = (xi1 - xi) / l
                yLoc = (yPic - yi) * cosa - (xPic - xi) * sina
                xLoc = (yPic - yi) * sina + (xPic - xi) * cosa
                If xLoc > 0 And xLoc < l Then
                    If Abs(yLoc) < yLocMin Then
                        iPrev = i
                        yLocMin = Abs(yLoc)
                    End If
                End If
WWW:
           Next i
       End If
'MsgBox ("2222iPrev=" & CStr(iPrev))

        PreviousVertex = iPrev
End Function


Examples - Surveyor Dimension Tool - SurvReg.bas

SurvReg.bas

Surveyor Dimension Tool Example

Attribute VB_Name = "modSurvReg"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
'Type TextSym
'    Char As String
'    H As Double
'    W As Double
'    xMin As Double
'    yMin As Double
'    xc As Double
'    yc As Double
'End Type
'Type CosmInfo
'    nV As Long
'    lCur() As Double
'    dL() As Double
'    xVer() As Double
'    yVer() As Double
'    Bet() As Double
'End Type
'Type GrInfo
'    nV As Long
'    xVer() As Double
'    yVer() As Double
'    Bulge() As Boolean
'End Type
'Type PolyInfo
'    NumSeg As Long
'    xMid() As Double
'    yMid() As Double
'    iBeg() As Long
'    L() As Double
'End Type

' DLL Entry point
Sub Main()
End Sub


Examples - Surveyor Dimension Tool - SurvReg.cls

SurvReg.cls

Surveyor Dimension Tool Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CoordReg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Private Declare Function TCWDrawingActive Lib "TCAPI70.dll" () As Long
Private Declare Function TCWGraphicAt Lib "TCAPI70.dll" (ByVal d As Long, ByVal Index As Long) As Long
Private Declare Function TCWVertexAt Lib "TCAPI70.dll" (ByVal g As Long, ByVal Index As Long) As Long
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265
Const Eps = 0.000001

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idSurvText = 1
Const idGrConID = 2
Const idTextGap = 3
Const idTextLocation = 4
Const idGrConIDOld = 5
Const idConVertex = 6
Const idHeightText = 7
Const idGrConType = 8
Const idUnits = 9

Const idUppendLenUnit = 10
Const idLenUnit = 11
Const idLenPrecision = 12

Const idPreffix = 13
Const idSuffix = 14

'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 14
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "SDK_SurvCoord"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{D25185FF-6A20-11d0-A115-00A024158DAF}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
    Names(0) = "SurvText"
    Types(0) = typeString
    IDs(0) = idSurvText
    Defaults(0) = "String"

    Names(1) = "GrConID"
    Types(1) = typeLong
    IDs(1) = idGrConID
    Defaults(1) = -1

    Names(2) = "TextGap"
    Types(2) = typeDouble
    IDs(2) = idTextGap
    Defaults(2) = 0#

    Names(3) = "TextLocation"
    Types(3) = typeInteger
    IDs(3) = idTextLocation
    Defaults(3) = 1 ' 1 - Above
                    ' 0 - Middle
                    ' -1 - Bottom
    Names(4) = "GrConIDOld"
    Types(4) = typeLong
    IDs(4) = idGrConIDOld
    Defaults(4) = -1

    Names(5) = "ConVertex"
    Types(5) = typeLong
    IDs(5) = idConVertex
    Defaults(5) = -1

    Names(6) = "HeightText"
    Types(6) = typeDouble
    IDs(6) = idHeightText
    Defaults(6) = 0.25

    Names(7) = "GrConType"
    Types(7) = typeString
    IDs(7) = idGrConType
    Defaults(7) = ""

    Names(8) = "Units"  ' Drawing Units
    Types(8) = typeString
    IDs(8) = idUnits
    Defaults(8) = ""

Const idUppendLenUnit = 10
Const idLenUnit = 11
Const idLenPrecision = 12

    Names(9) = "UppendLenUnit"  ' add dimension length unit to dimension
    Types(9) = typeInteger      ' 1-add
    IDs(9) = idUppendLenUnit    ' 0- absent
    Defaults(9) = 1

    Names(10) = "LenUnit"  ' dimension's length unit
    Types(10) = typeString
    IDs(10) = idLenUnit
    Defaults(10) = "in"

    Names(11) = "LenPrecision"  ' dimension's length unit
    Types(11) = typeInteger
    IDs(11) = idLenPrecision
    Defaults(11) = 2

    Names(12) = "Preffix"
    Types(12) = typeString
    IDs(12) = idPreffix
    Defaults(12) = ""

    Names(13) = "Suffix"
    Types(13) = typeString
    IDs(13) = idSuffix
    Defaults(13) = ""

    GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmSurvReg
    Names(0) = frmSurvReg.Caption
    Unload frmSurvReg

    StockPages = ppStockBrush + ppStockPen + ppStockText + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
    GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Graphic As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function
        On Error GoTo Failed

Dim SurvText$
Dim Location%
Dim TextLocation$
Dim HeightText#
Dim UppendLenUnit%
Dim LenUnit$
Dim LenPrecision%
Dim TextGap#
Dim Preffix$
Dim Suffix$

        If SaveProperties Then
            'OK button on property page was clicked
            'Form is still loaded
            With frmSurvReg
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next
                'When the property page is closed, transfer the numeric

                SurvText = .SurvText.Text
                Graphic.Properties("SurvText") = SurvText

                Preffix = .Preffix.Text
                Graphic.Properties("Preffix") = Preffix

                Suffix = .Suffix.Text
                Graphic.Properties("Suffix") = Suffix

                TextLocation = .Location.Text
                If TextLocation = "Above" Then Location = 1
                If TextLocation = "Middle" Then Location = 0
                If TextLocation = "Bottom" Then Location = -1
                Graphic.Properties("TextLocation") = Location

                TextGap = CDbl(.TextGap.Text)
                Graphic.Properties("TextGap") = TextGap

                HeightText = CDbl(.HeightText.Text)
                Graphic.Properties("HeightText") = HeightText

                UppendLenUnit = .UppendLenUnits.Value
                Graphic.Properties("UppendLenUnit") = UppendLenUnit

                LenUnit = .LenUnits.Text
                Graphic.Properties("LenUnit") = LenUnit

                LenPrecision = CInt(.LenPrecision.Text)
                Graphic.Properties("LenPrecision") = LenPrecision

            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
            Load frmSurvReg
            With frmSurvReg
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric

                SurvText = Graphic.Properties("SurvText")
                .SurvText.Text = SurvText

                Preffix = Graphic.Properties("Preffix")
                .Preffix.Text = Preffix

                Suffix = Graphic.Properties("Suffix")
                .Suffix.Text = Suffix

                Location = Graphic.Properties("TextLocation")
                If Location = 1 Then
                    .Location.Text = "Above"
                End If
                If Location = 0 Then
                    .Location.Text = "Middle"
                End If
                If Location = -1 Then
                    .Location.Text = "Bottom"
                End If

                TextGap = Graphic.Properties("TextGap")
                .TextGap.Text = CStr(TextGap)

                HeightText = Graphic.Properties("HeightText")
                .HeightText.Text = CStr(HeightText)

                UppendLenUnit = Graphic.Properties("UppendLenUnit")
                .UppendLenUnits.Value = UppendLenUnit

                LenUnit = Graphic.Properties("LenUnit")
                .LenUnits.Text = LenUnit

                LenPrecision = Graphic.Properties("LenPrecision")
                .LenPrecision.Text = CStr(LenPrecision)
                .VScroll1.Value = LenPrecision

NoRType:
            End With
        End If

        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmSurvReg
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
    With frmSurvReg
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If
Dim Gr As Graphic
    Set Gr = grfThis

    On Error GoTo Failed

    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    With Gr.Vertices
        .Add 0, 0, 0, False
        .Add -1, 0, 0, False ', False, False, False, False
        .Add 1, 0, 0, False ', False, False, False, False
    End With
    Gr.Properties("LimitVertices") = 3
    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis As Object)
'MsgBox ("Regen")
        'Setup error handler
        On Error GoTo Failed
Dim Gr As Graphic
Dim Gr1 As Graphic
Dim GrCon As Graphic
    Set Gr = grfThis
        'Set up lock (prevent recursion)
Dim LockCount&
    LockCount& = grfThis.RegenLock

        'Setup error handler (make sure lock is removed)
On Error GoTo FailedLock
'###################################################################
    If LockCount& = 0 Then
Dim NewGraphic As Boolean
        NewGraphic = False
Dim UnitName$, UnitNameOld$
Dim Space%
        Space = Gr.Drawing.Properties("TileMode") ' Modal or Paper space
        If Space <> 1 Then
            UnitName = Gr.Drawing.Properties("PaperLinearUnitName")
        Else
            UnitName = Gr.Drawing.Properties("LinearUnitName")
        End If
        UnitNameOld = Gr.Properties("Units")

        If UnitNameOld = "" Then
            'If New graphic
            NewGraphic = True
            Gr.Properties("Units") = UnitName
        Else
            NewGraphic = False
            ' Delete all Cosmetic
            Gr.Graphics.Clear gfCosmetic
        End If

Dim x0#, y0#, x1#, y1#, x2#, y2#
        With Gr.Vertices
            x0 = .Item(0).X
            y0 = .Item(0).y
            x1 = .Item(1).X
            y1 = .Item(1).y
            x2 = .Item(2).X
            y2 = .Item(2).y
        End With

Dim GrConID As Long
Dim GrConType$
Dim ConVertex As Long
Dim VerCon As Vertex
Dim ConVerCount As Long
        GrConID = Gr.Properties("GrConID")
'MsgBox ("000000 GrConid=" & CStr(GrConID))
        If GrConID <> -1 Then
            Set GrCon = Nothing
            On Error Resume Next
            Set GrCon = Gr.Drawing.Graphics.GraphicFromID(GrConID)
            If GrCon Is Nothing Then
                GrConID = -1
            Else
Dim Res As Long
Dim TieWasted As Boolean
                Res = ConnectionExist(Gr, GrConID, TieWasted)
Dim GrConIDOld As Long
                GrConIDOld = Gr.Properties("GrConIDOld")

                If Res = -1 And GrConIDOld <> -1 Then
                    Gr.Properties("GrConID") = -1
                    GrConID = -1
                End If
                If Res <> -1 And TieWasted = True Then
                    GrConID = -1
                End If
            End If
            If GrConID <> -1 Then
                ConVertex = Gr.Properties("ConVertex")
'MsgBox ("00000ConVertex=" & CStr(ConVertex))
                Set VerCon = Nothing
                On Error Resume Next
                Set VerCon = GrCon.Vertices(ConVertex)
                If VerCon Is Nothing Then
'                    Gr.Properties("GrConID") = -1
                    GrConID = -1
                Else
                    If ConVertex <> 0 Then
                        If VerCon.Bulge = True And GrCon.Vertices(ConVertex - 1).Bulge = False Then
                            ConVertex = ConVertex - 1
'                            Gr.Properties("ConVertex") = ConVertex
                        Else
                            If VerCon.Bulge = True And GrCon.Vertices(ConVertex - 1).Bulge = True Then
                                ConVertex = ConVertex - 2
'                                Gr.Properties("ConVertex") = ConVertex
                            End If
                        End If
                    End If
                End If
'MsgBox ("11111 GrConid=" & CStr(GrConID) & " ConVertex=" & CStr(ConVertex))

                Set VerCon = Nothing
                On Error Resume Next
                Set VerCon = GrCon.Vertices(ConVertex + 1)
                If VerCon Is Nothing Then
'                    Gr.Properties("GrConID") = -1
                    GrConID = -1
                End If
'MsgBox ("22222 GrConid=" & CStr(GrConID) & " ConVertex=" & CStr(ConVertex))

            End If
        End If

        GrConType = Gr.Properties("GrConType")
Dim SurvText$
        SurvText = Gr.Properties("SurvText")
Dim Preffix$
        Preffix = Gr.Properties("Preffix")
Dim Suffix$
        Suffix = Gr.Properties("Suffix")
Dim HText#
        HText = Gr.Properties("HeightText")
'####################################################################
        If GrConID = -1 Then
        Else
'            If GrConType = "GRAPHIC" Then
'                SurvText = LineSurveourString(Gr, GrCon,ConVertex)
'                Gr.Properties("SurvText") = SurvText
'            End If
            If GrConType = "ARC" Then
                SurvText = ArcSurveourString(Gr, GrCon)
                Gr.Properties("SurvText") = SurvText
            End If
            If GrConType = "GRAPHIC" Or GrConType = "TCW50Polyline" Then
                SurvText = PolylineSurveourString(Gr, GrCon, ConVertex)
'MsgBox (SurvText)
                Gr.Properties("SurvText") = SurvText
            End If
        End If
Dim CommonText$
        CommonText = ""
        CommonText = Preffix & SurvText & Suffix
        SurvText = CommonText

'####################################################################
' Begin Add Symbols from string as Cosmetic
Dim StrLen As Long, i As Long
        StrLen = VBA.Len(SurvText)
Dim Char$
Dim GrText As Graphic

Dim xMax#, yMax#, xMin#, yMin#, LText#, xcText#, yCText#
        LText = 0
        Set GrText = Gr.Graphics.AddText(SurvText, 0, 0, 0, HText)
        GrText.Properties("PenColor") = Gr.Properties("PenColor")
            GrText.Cosmetic = True
        With GrText.CalcBoundingBox
            LText = .Max.X - .Min.X
            xcText = (.Max.X + .Min.X) / 2
            yCText = (.Max.y + .Min.y) / 2
        End With

' End Add Symbols from string as Cosmetic
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

'######################################################################
        ' begin if new graphic
Dim xmid#, ymid#
        If NewGraphic = True Then
            With Gr.Vertices
                .Item(1).X = x0 - LText / 2
                .Item(1).y = y0
                .Item(1).Editable = False
                .Item(2).X = x0 + LText / 2
                .Item(2).y = y0
                .Item(2).Editable = False
            End With
            xmid = x0
            ymid = y0
            GrText.MoveRelative xmid - xcText, ymid - yCText, 0
        End If
        ' end if new graphic
'######################################################################
        If GrConID = -1 And NewGraphic = False Then
Dim ChildArcExist As Boolean
            ChildArcExist = False
Dim GrCirc As Graphic
Dim ChildCount As Long
            With Gr.Graphics
                ChildCount = .Count
                For i = 0 To ChildCount - 1
                    If .Item(i).Type = "ARC" Then
                        Set GrCirc = .Item(i)
                        ChildArcExist = True
                        Exit For
                    End If
                Next i
            End With
            If ChildArcExist = False Then
                Call LineText(Gr, GrText, LText, HText, xcText, yCText)
            Else
                Call TextAlongCosmeticCircle(Gr, GrText, GrCirc, HText)
            End If
        Else

            If GrConType = "ARC" Then
                GrText.Deleted = True
                Call TextAlongCircle(Gr, GrCon, SurvText, HText, 1)
            End If
            If GrConType = "GRAPHIC" Or GrConType = "TCW50Polyline" Then
                Call TextAlongPolyline(Gr, GrCon, GrText, SurvText, HText, LText, xcText, yCText, ConVertex)
            End If
        End If
LEND:
        If GrConID <> -1 Then
            Gr.Properties("GrConIDOld") = GrConID
        End If
        Set GrText = Nothing
    End If
'###################################################################

    Gr.RegenUnlock

    Exit Function

FailedLock:
        'Remove lock
        grfThis.RegenUnlock

'        Set Grs = Nothing
Failed:

        If Err.Number <> 0 Then
            MsgBox "Regen error: " & Err.Description
        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean

    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
    Draw = False
End Function

Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function
Private Function Sign(y As Double) As Double
    If Abs(y) < 0.001 Then
        Sign = 0
        Exit Function
    End If
    If y < 0 Then
        Sign = -1#
        Exit Function
    End If
    If y > 0 Then
        Sign = 1#
        Exit Function
    End If
End Function

Private Sub LineText(Gr As Graphic, GrText As Graphic, LText#, HText#, xcText#, yCText#)
'MsgBox ("TextAlongLine")

Dim x0#, y0#, x1#, y1#, x2#, y2#
        With Gr.Vertices
            x0 = .Item(0).X
            y0 = .Item(0).y
            x1 = .Item(1).X
            y1 = .Item(1).y
            x2 = .Item(2).X
            y2 = .Item(2).y
        End With

        ' Define if was moved the center vertex of the text
Dim L#, sina#, cosa#, x0Loc#, y0Loc#
Dim Alpha#
        L = Sqr((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1))
        If L > Eps Then
            sina = (y2 - y1) / L
            cosa = (x2 - x1) / L
        Else
            sina = 0
            cosa = 1
        End If
        Alpha = Angle(sina, cosa)
        x1 = x0 + LText / 2 * Cos(Alpha + Pi)
        y1 = y0 + LText / 2 * Sin(Alpha + Pi)
        x2 = x0 + LText / 2 * Cos(Alpha)
        y2 = y0 + LText / 2 * Sin(Alpha)

        With Gr.Vertices
            .Item(1).X = x1
            .Item(1).y = y1
            .Item(2).X = x2
            .Item(2).y = y2
        End With

       GrText.RotateAxis Alpha, 0, 0, 1, xcText, yCText, 0
       GrText.MoveRelative x0 - xcText, y0 - yCText, 0

End Sub

' Update the text along connected Line

Private Sub TextAlongLine(Gr As Graphic, GrLine As Graphic, GrText As Graphic, HText#, LText#, xcText#, yCText#, ConVertex As Long)
'MsgBox ("TextAlongLine")
Dim i As Long
Dim TextLocation%
    TextLocation = Gr.Properties("TextLocation")
Dim TextGap#
    TextGap = Gr.Properties("TextGap")
'Dim ConVertex As Long
'    ConVertex = Gr.Properties("ConVertex")
    If ConVertex = -1 Then ConVertex = 0

'############################################################
    ' Define the geometry parameters of Connected line
Dim x0L#, y0L#, x1L#, y1L#
        With GrLine.Vertices
            x0L = .Item(ConVertex).X
            y0L = .Item(ConVertex).y
            x1L = .Item(ConVertex + 1).X
            y1L = .Item(ConVertex + 1).y
        End With
Dim lL#, sinaL#, cosaL#
Dim AlphaL#
        lL = Sqr((x1L - x0L) * (x1L - x0L) + (y1L - y0L) * (y1L - y0L))
        sinaL = (y1L - y0L) / lL
        cosaL = (x1L - x0L) / lL
        AlphaL = Angle(sinaL, cosaL)
'############################################################

Dim xLoc0#, yLoc0#, xLoc1#, yLoc1#, xLoc2#, yLoc2#
Dim x0#, y0#, x1#, y1#, x2#, y2#
        With Gr.Vertices
            x0 = .Item(0).X ' Center point of the text
            y0 = .Item(0).y
'            x1 = .Item(1).x ' Limit points of the text
'            y1 = .Item(1).y
'            x2 = .Item(2).x
'            y2 = .Item(2).y
        End With

' Begin If first connection text to line
Dim GrConIDOld As Long
        GrConIDOld = Gr.Properties("GrConIDOld")
        If GrConIDOld = -1 Or lL < LText Then
            x0 = (x1L + x0L) / 2
            y0 = (y1L + y0L) / 2
            xLoc1 = lL / 2 - LText / 2
            yLoc1 = 0
            xLoc2 = lL / 2 + LText / 2
            yLoc2 = 0
            xLoc0 = lL / 2
            yLoc0 = 0
' End If first connection text to line
        Else
            xLoc0 = (y0 - y0L) * sinaL + (x0 - x0L) * cosaL
            xLoc1 = xLoc0 - LText / 2
            xLoc2 = xLoc0 + LText / 2
            If xLoc1 < 0 Then
                xLoc0 = LText / 2
                xLoc1 = 0
                xLoc2 = LText
            End If
            If xLoc2 > lL Then
                xLoc0 = lL - LText / 2
                xLoc1 = lL - LText
                xLoc2 = lL
            End If

        End If
        x1 = x0L + xLoc1 * cosaL - yLoc1 * sinaL
        y1 = y0L + xLoc1 * sinaL + yLoc1 * cosaL

        x2 = x0L + xLoc2 * cosaL - yLoc2 * sinaL
        y2 = y0L + xLoc2 * sinaL + yLoc2 * cosaL

'########################################################################
        If TextLocation = 1 Then ' If text above line
            If cosaL < -0.01 Then
                yLoc0 = -HText / 2
            Else
                yLoc0 = HText / 2
            End If
        End If
        If TextLocation = 0 Then ' If text Middle line
            yLoc0 = 0
        End If
        If TextLocation = -1 Then ' If text Middle line
            If cosaL < -0.01 Then
                yLoc0 = HText / 2
            Else
                yLoc0 = -HText / 2
            End If
        End If
        yLoc1 = yLoc0
        yLoc2 = yLoc0

'########################################################################
        'new coordinates for the Base Text vertices
        x0 = x0L + xLoc0 * cosaL - yLoc0 * sinaL
        y0 = y0L + xLoc0 * sinaL + yLoc0 * cosaL

        x1 = x0L + xLoc1 * cosaL - yLoc1 * sinaL
        y1 = y0L + xLoc1 * sinaL + yLoc1 * cosaL

        x2 = x0L + xLoc2 * cosaL - yLoc2 * sinaL
        y2 = y0L + xLoc2 * sinaL + yLoc2 * cosaL

' Begin examine the location of the limits text vertices
Dim sina#, cosa#, xTem#, yTem#, L#
Dim Alpha#
        L = Sqr((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1))
        sina = (y2 - y1) / L
        cosa = (x2 - x1) / L
        Alpha = Angle(sina, cosa)
        If cosa < -0.01 Then
'MsgBox ("Alpha=" & CStr(Alpha * 180 / Pi) & "  cosa=" & CStr(cosa))
            xTem = x1
            yTem = y1
            x1 = x2
            y1 = y2
            x2 = xTem
            y2 = yTem
            xTem = xLoc1
            xLoc1 = xLoc2
            xLoc2 = xTem
            Alpha = Alpha + Pi
        End If
' End examine the location of the limits text vertices
'MsgBox ("AlongLine x0=" & CStr(x0) & " y0=" & CStr(y0))

        With Gr.Vertices
            .Item(0).X = x0
            .Item(0).y = y0
            .Item(1).X = x1
            .Item(1).y = y1
            .Item(2).X = x2
            .Item(2).y = y2
        End With
        ' correct location of the center child graphic

' locate text between 2 limits vertices
    GrText.RotateAxis Alpha, 0, 0, 1, xcText, yCText, 0
    GrText.MoveRelative x0 - xcText, y0 - yCText, 0
End Sub

' Update text Along Connected Arc

Private Sub TextAlongCircle(Gr As Graphic, GrCirc As Graphic, SurvText As String, HText#, Dictinct%)
'MsgBox ("TextAlongCircle")
Dim TextLocation%
    TextLocation = Gr.Properties("TextLocation")
Dim TextGap#
    TextGap = Gr.Properties("TextGap")
Dim GrConIDOld As Long
        GrConIDOld = Gr.Properties("GrConIDOld")

Dim Offset#

        If TextLocation = 1 Then    ' If Text outside circle
            Offset = Dictinct * (TextGap + HText / 2)
        End If
        If TextLocation = 0 Then    ' If Text on circle
            Offset = TextGap
        End If
        If TextLocation = -1 Then   ' If Text inside circle
            Offset = Dictinct * (-TextGap - HText / 2)
        End If
'MsgBox ("1111GrCount=" & CStr(Gr.Graphics.Count))
Dim ChildCount As Long
Dim i As Long
        With Gr.Graphics
            ChildCount = .Count
            For i = 0 To ChildCount - 1
                If .Item(i).Type = "ARC" Then
                    .Item(i).Deleted = True
                    Exit For
                End If
            Next i
        End With
'MsgBox (GrCirc.Vertices.Count)
' Difine the parameters of circle
Dim xc#, yc#, R#, x1C#, y1C#, x2C#, y2C#, x3C#, y3C#
Dim fiBegC#, fiEndC#
Dim L#, sina#, cosa#, x0Loc#, y0Loc#
Dim Alpha#
        With GrCirc.Vertices
            xc = .Item(0).X
            yc = .Item(0).y
            x1C = .Item(1).X
            y1C = .Item(1).y
            x2C = .Item(2).X
            y2C = .Item(2).y
'            x3C = .Item(3).x
'            y3C = .Item(3).y
        End With
        R = Sqr((x1C - xc) * (x1C - xc) + (y1C - yc) * (y1C - yc))
'MsgBox ("R=" & CStr(R))
        sina = (y1C - yc) / R
        cosa = (x1C - xc) / R
        fiBegC = Angle(sina, cosa)
        sina = (y2C - yc) / R
        cosa = (x2C - xc) / R
        fiEndC = Angle(sina, cosa)
'MsgBox ("R=" & CStr(R) & "  fiBegC=" & CStr(fiBegC) & "  fiEndC=" & CStr(fiEndC))
        If fiBegC - fiEndC > Eps Then fiBegC = fiBegC - 2 * Pi
Dim LArc#
        LArc = (R + Offset) * (fiEndC - fiBegC)

' Define the Parameters of the text
Dim GrText As Graphic
Dim LText#
        Set GrText = Gr.Graphics.AddText(SurvText, 0, 0, 0, HText)
        With GrText.CalcBoundingBox
            LText = .Max.X - .Min.X
        End With
        GrText.Deleted = True
Dim StrLen As Long
        StrLen = CLng(VBA.Len(SurvText))

Dim x0#, y0#, x1#, y1#, x2#, y2#
        With Gr.Vertices
            x0 = .Item(0).X
            y0 = .Item(0).y
            .Item(0).Editable = True
            x1 = .Item(1).X
            y1 = .Item(1).y
            .Item(1).Editable = False
            x2 = .Item(2).X
            y2 = .Item(2).y
            .Item(2).Editable = False
        End With
Dim fiBegT#, fiEndT#, fiMidT#, dfiText#
        L = Sqr((x0 - xc) * (x0 - xc) + (y0 - yc) * (y0 - yc))
        sina = (y0 - yc) / L
        cosa = (x0 - xc) / L
        fiMidT = Angle(sina, cosa)

        L = Sqr((x1 - xc) * (x1 - xc) + (y1 - yc) * (y1 - yc))
        sina = (y1 - yc) / L
        cosa = (x1 - xc) / L
        fiBegT = Angle(sina, cosa)

        L = Sqr((x2 - xc) * (x2 - xc) + (y2 - yc) * (y2 - yc))
        sina = (y2 - yc) / L
        cosa = (x2 - xc) / L
        fiEndT = Angle(sina, cosa)

        If Sin(fiBegT) > 0 And Sin(fiEndT) < 0 Then fiEndT = fiEndT - 2 * Pi

        dfiText = LText / (R + Offset)

'MsgBox ("fiBegC=" & CStr(fiBegC * 180 / Pi) & "  fiMidT=" & CStr(fiMidT * 180 / Pi) & "  dfiText=" & CStr(dfiText * 180 / Pi))
        If LText < LArc Then
Dim fiBegCLoc#, fiEndCLoc#, fiMidTLoc#
            fiBegCLoc = fiBegC - fiBegC
            fiEndCLoc = fiEndC - fiBegC
            fiMidTLoc = fiMidT - fiBegC
            If fiMidTLoc > 2 * Pi Then fiMidTLoc = fiMidTLoc - 2 * Pi
            If fiMidTLoc > fiEndCLoc Then
                fiMidTLoc = fiEndCLoc - dfiText / 2
            Else
                If fiMidTLoc > fiEndCLoc - dfiText / 2 Then
                    fiMidTLoc = fiEndCLoc - dfiText / 2
                End If
                If fiMidTLoc < fiBegCLoc + dfiText / 2 Then
                    fiMidTLoc = fiBegCLoc + dfiText / 2
                End If
            End If
            fiMidT = fiMidTLoc + fiBegC
        Else
            fiMidT = (fiBegC + fiEndC) / 2
        End If
        'first connection to the Circle
        If GrConIDOld = -1 Or LText > LArc Then
            fiMidT = (fiBegC + fiEndC) / 2
        End If

        fiBegT = fiMidT - dfiText / 2
        fiEndT = fiMidT + dfiText / 2

        x1 = xc + R * Cos(fiBegT)
        y1 = yc + R * Sin(fiBegT)
        x2 = xc + R * Cos(fiEndT)
        y2 = yc + R * Sin(fiEndT)

        x0 = xc + (R + Offset) * Cos((fiBegT + fiEndT) / 2)
        y0 = yc + (R + Offset) * Sin((fiBegT + fiEndT) / 2)

        x1 = xc + (R + Offset) * Cos(fiBegT)
        y1 = yc + (R + Offset) * Sin(fiBegT)

        x2 = xc + (R + Offset) * Cos(fiEndT)
        y2 = yc + (R + Offset) * Sin(fiEndT)

        With Gr.Vertices
            .Item(0).X = x0
            .Item(0).y = y0
            .Item(1).X = x1
            .Item(1).y = y1
            .Item(2).X = x2
            .Item(2).y = y2
        End With
Dim dfi#
        dfi = dfiText / (StrLen - 1)

Dim Char$
Dim hChar#, wChar#, xcChar#, ycChar#, wCharBase#
Dim fi#, ri#, xi#, yi#, fi0#, fik#
        If Sin(fiMidT) > 0 Then
            fi = fiEndT
            fi0 = fi
        Else
            fi = fiBegT
            fi0 = fi
        End If

Dim GrBaseSym As Graphic
        Char = VBA.Mid(SurvText, 1, 1)
        Set GrBaseSym = Gr.Graphics.AddText("2", 0, 0, 0, HText)
        With GrBaseSym.CalcBoundingBox
            wCharBase = .Max.X - .Min.X
        End With
            GrBaseSym.Cosmetic = True
        For i = 0 To StrLen - 1
            Char = VBA.Mid(SurvText, i + 1, 1)
            Set GrText = GrBaseSym.Duplicate
            GrText.Properties("Info") = Char

            With GrText.CalcBoundingBox
                wChar = .Max.X - .Min.X
                If wChar < wCharBase Then
                    wChar = wCharBase
                End If
'                hChar = .Max.y - .Min.y
                xcChar = (.Max.X + .Min.X) / 2
                ycChar = (.Max.y + .Min.y) / 2
            End With
            dfi = wChar / (R + Offset)
Dim fii#
            If Sin(fiMidT) > 0 Then
                fi = fi - dfi
                fii = fi - dfi / 2
            Else
                fi = fi + dfi
                fii = fi + dfi / 2
            End If

            xi = xc + (R + Offset) * Cos(fi)
            yi = yc + (R + Offset) * Sin(fi)
            If Sin(fiMidT) > 0 Then
                GrText.RotateAxis fi - Pi / 2, 0, 0, 1, xcChar, ycChar, 0
            Else
                GrText.RotateAxis fi + Pi / 2, 0, 0, 1, xcChar, ycChar, 0
            End If
            GrText.MoveRelative xi - xcChar, yi - ycChar, 0
        Next i

        fik = fi

Dim GrArc As Graphic
        x0 = xc + (R + Offset) * Cos(fi0)
        y0 = yc + (R + Offset) * Sin(fi0)
        x1 = xc + (R + Offset) * Cos(fik)
        y1 = yc + (R + Offset) * Sin(fik)
        x2 = xc + (R + Offset) * Cos(fiMidT)
        y2 = yc + (R + Offset) * Sin(fiMidT)
        Set GrArc = Gr.Graphics.AddArcTriplePoint(x0, y0, 0, x2, y2, 0, x1, y1, 0)
        GrArc.Visible = False
        GrBaseSym.Deleted = True
        Set GrBaseSym = Nothing
        Set GrArc = Nothing

End Sub

' Update text Along Cosmetic Arc

Private Sub TextAlongCosmeticCircle(Gr As Graphic, GrText As Graphic, GrCirc As Graphic, HText#)
'MsgBox ("TextAlongCosmeticCircle")

Dim i As Long
' Difine the parameters of circle
Dim xc#, yc#, R#, x1C#, y1C#, x2C#, y2C#, x3C#, y3C#
Dim fiBegC#, fiEndC#
Dim L#, sina#, cosa#, x0Loc#, y0Loc#
Dim Alpha#
        With GrCirc.Vertices
            xc = .Item(0).X
            yc = .Item(0).y
            x1C = .Item(1).X
            y1C = .Item(1).y
            x2C = .Item(2).X
            y2C = .Item(2).y
'            x3C = .Item(3).x
'            y3C = .Item(3).y
        End With
        R = Sqr((x1C - xc) * (x1C - xc) + (y1C - yc) * (y1C - yc))
        sina = (y1C - yc) / R
        cosa = (x1C - xc) / R
        fiBegC = Angle(sina, cosa)
        sina = (y2C - yc) / R
        cosa = (x2C - xc) / R
        fiEndC = Angle(sina, cosa)

        If fiBegC - fiEndC > Eps Then fiBegC = fiBegC - 2 * Pi
Dim LArc#
        LArc = R * (fiEndC - fiBegC)

' Define the Parameters of the text
Dim SurvText$
        SurvText = GrText.Properties("Info")
Dim LText#
        With GrText.CalcBoundingBox
            LText = .Max.X - .Min.X
        End With
        GrText.Deleted = True

Dim StrLen As Long
        StrLen = CLng(VBA.Len(SurvText))

Dim x0#, y0#, x1#, y1#, x2#, y2#
        With Gr.Vertices
            x0 = .Item(0).X
            y0 = .Item(0).y
            .Item(0).Editable = True
            x1 = .Item(1).X
            y1 = .Item(1).y
            .Item(1).Editable = False
            x2 = .Item(2).X
            y2 = .Item(2).y
            .Item(2).Editable = False
        End With
Dim fiBegT#, fiEndT#, fiMidT#, dfiText#
        L = Sqr((x0 - xc) * (x0 - xc) + (y0 - yc) * (y0 - yc))
        sina = (y0 - yc) / L
        cosa = (x0 - xc) / L
        fiMidT = Angle(sina, cosa)

        L = Sqr((x1 - xc) * (x1 - xc) + (y1 - yc) * (y1 - yc))
        sina = (y1 - yc) / L
        cosa = (x1 - xc) / L
        fiBegT = Angle(sina, cosa)

        L = Sqr((x2 - xc) * (x2 - xc) + (y2 - yc) * (y2 - yc))
        sina = (y2 - yc) / L
        cosa = (x2 - xc) / L
        fiEndT = Angle(sina, cosa)

        If Sin(fiBegT) > 0 And Sin(fiEndT) < 0 Then fiEndT = fiEndT - 2 * Pi

        dfiText = LText / R

        fiMidT = (fiBegC + fiEndC) / 2

'        fiBegT = fiMidT - dfiText / 2
'        fiEndT = fiMidT + dfiText / 2

        x1 = xc + R * Cos(fiBegT)
        y1 = yc + R * Sin(fiBegT)
        x2 = xc + R * Cos(fiEndT)
        y2 = yc + R * Sin(fiEndT)

        x0 = xc + R * Cos((fiBegT + fiEndT) / 2)
        y0 = yc + R * Sin((fiBegT + fiEndT) / 2)

        x1 = xc + R * Cos(fiBegT)
        y1 = yc + R * Sin(fiBegT)

        x2 = xc + R * Cos(fiEndT)
        y2 = yc + R * Sin(fiEndT)

        With Gr.Vertices
            .Item(0).X = x0
            .Item(0).y = y0
            .Item(1).X = x1
            .Item(1).y = y1
            .Item(2).X = x2
            .Item(2).y = y2
        End With
Dim dfi#
        dfi = dfiText / (StrLen - 1)

Dim Char$
Dim hChar#, wChar#, xcChar#, ycChar#, wCharBase#
Dim fi#, ri#, xi#, yi#, fi0#, fik#
        If Sin(fiMidT) > 0 Then
            fi = fiEndT
            fi0 = fi
        Else
            fi = fiBegT
            fi0 = fi
        End If

Dim GrBaseSym As Graphic
        Char = VBA.Mid(SurvText, 1, 1)
        Set GrBaseSym = Gr.Graphics.AddText("2", 0, 0, 0, HText)
        With GrBaseSym.CalcBoundingBox
            wCharBase = .Max.X - .Min.X
        End With
            GrBaseSym.Cosmetic = True
        For i = 0 To StrLen - 1
            Char = VBA.Mid(SurvText, i + 1, 1)
            Set GrText = GrBaseSym.Duplicate
            GrText.Properties("Info") = Char

            With GrText.CalcBoundingBox
                wChar = .Max.X - .Min.X
                If wChar < wCharBase Then
                    wChar = wCharBase
                End If
'                hChar = .Max.y - .Min.y
                xcChar = (.Max.X + .Min.X) / 2
                ycChar = (.Max.y + .Min.y) / 2
            End With
            dfi = wChar / R
Dim fii#
            If Sin(fiMidT) > 0 Then
                If i = 0 Then
                    fi = fi - dfi / 2
                    fii = fi0
                Else
                    fi = fi - dfi
                    fii = fi + dfi / 2
                End If
            Else
                If i = 0 Then
                    fi = fi + dfi / 2
                    fii = fi0
                Else
                    fi = fi + dfi
                    fii = fi - dfi / 2
                End If
            End If
            xi = xc + R * Cos(fii)
            yi = yc + R * Sin(fii)
            If Sin(fiMidT) > 0 Then
                GrText.RotateAxis fii - Pi / 2, 0, 0, 1, xcChar, ycChar, 0
            Else
                GrText.RotateAxis fii + Pi / 2, 0, 0, 1, xcChar, ycChar, 0
            End If
            GrText.MoveRelative xi - xcChar, yi - ycChar, 0

        Next i

        fik = fii

        GrCirc.Deleted = True

        x0 = xc + R * Cos(fi0)
        y0 = yc + R * Sin(fi0)
        x1 = xc + R * Cos(fik)
        y1 = yc + R * Sin(fik)
        x2 = xc + R * Cos(fiMidT)
        y2 = yc + R * Sin(fiMidT)
        Set GrCirc = Gr.Graphics.AddArcTriplePoint(x0, y0, 0, x2, y2, 0, x1, y1, 0)
        GrCirc.Visible = False
        GrBaseSym.Deleted = True
        Set GrBaseSym = Nothing

End Sub

' Define Surveuor string for Line Segment
Private Function LineSurveourString(GrText As Graphic, GrLine As Graphic, ConVertex As Long) As String
'Dim ConVertex As Long
'    ConVertex = GrText.Properties("ConVertex")
Dim UppendLenUnit%
    UppendLenUnit = GrText.Properties("UppendLenUnit")
Dim LenUnit$
    LenUnit = GrText.Properties("LenUnit")
Dim LenPrecision%
    LenPrecision = GrText.Properties("LenPrecision")
'MsgBox ("ConVertex=" & CStr(ConVertex))
Dim x0#, y0#, x1#, y1#
    With GrLine.Vertices
        x0 = .Item(ConVertex).X
        y0 = .Item(ConVertex).y
        x1 = .Item(ConVertex + 1).X
        y1 = .Item(ConVertex + 1).y
    End With
Dim L#, sina#, cosa#, Alpha#
    L = Sqr((x1 - x0) * (x1 - x0) + (y1 - y0) * (y1 - y0))
'MsgBox ("l=" & CStr(l))
    sina = (y1 - y0) / L
    cosa = (x1 - x0) / L
    Alpha = Angle(sina, cosa)
Dim Beta#, Direction$
    If cosa = 0 And sina > 0 Then
        Direction = "NE"
        Beta = 0
        GoTo WW
    End If
    If cosa = 0 And sina < 0 Then
        Direction = "SE"
        Beta = 0
        GoTo WW
    End If
    If cosa > 0 And sina = 0 Then
        Direction = "NE"
        Beta = Pi / 2
        GoTo WW
    End If
    If cosa < 0 And sina = 0 Then
        Direction = "SE"
        Beta = Pi / 2
        GoTo WW
    End If

    If sina > 0 And cosa > 0 Then
        Direction = "NE"
        Beta = Pi / 2 - Alpha
        GoTo WW
    End If
    If sina > 0 And cosa < 0 Then
        Direction = "NW"
        Beta = Alpha - Pi / 2
        GoTo WW
    End If
    If sina < 0 And cosa < 0 Then
        Direction = "SW"
        Beta = 3 * Pi / 2 - Alpha
        GoTo WW
    End If
    If sina < 0 And cosa > 0 Then
        Direction = "SE"
        Beta = Alpha - 3 * Pi / 2
        GoTo WW
    End If
WW:
Dim BetaSec As Long
    BetaSec = Int(Beta * 180 * 3600 / Pi) ' Angle in second
Dim Deg As Long, Min As Long, Sec As Long, MinSec As Long
    Deg = Int(BetaSec / 3600)
    MinSec = BetaSec - Deg * 3600
    Min = Int(MinSec / 60)
    Sec = Int(MinSec - Min * 60)
Dim DegStr$, MinStr$, SecStr$
    If Deg > 9 Then
        DegStr = CStr(Deg)
    Else
        If Deg = 0 Then
            DegStr = "00"
        Else
            DegStr = "0" & CStr(Deg)
        End If
    End If
    If Min > 9 Then
        MinStr = CStr(Min)
    Else
        If Min = 0 Then
            MinStr = "00"
        Else
            MinStr = "0" & CStr(Min)
        End If
    End If
    If Sec > 9 Then
        SecStr = CStr(Sec)
    Else
        If Sec = 0 Then
            SecStr = "00"
        Else
            SecStr = "0" & CStr(Sec)
        End If
    End If

Dim AlphaStr$
    If Direction = "NE" Then
        AlphaStr = "N" & DegStr & VBA.Chr(186) & MinStr & "'" & SecStr & """" & "E"
    End If
    If Direction = "NW" Then
        AlphaStr = "N" & DegStr & VBA.Chr(186) & MinStr & "'" & SecStr & """" & "W"
    End If
    If Direction = "SE" Then
        AlphaStr = "S" & DegStr & VBA.Chr(186) & MinStr & "'" & SecStr & """" & "E"
    End If
    If Direction = "SW" Then
        AlphaStr = "S" & DegStr & VBA.Chr(186) & MinStr & "'" & SecStr & """" & "W"
    End If
Dim LStr$
    LStr = VBA.Format(L, "###0.00")
Dim Space%, UnitName$
    Space = GrText.Drawing.Properties("TileMode")
    If Space <> 1 Then
        UnitName = GrText.Drawing.Properties("PaperLinearUnitName")
    Else
        UnitName = GrText.Drawing.Properties("LinearUnitName")
    End If

    LStr = LStr & UnitName
    LineSurveourString = AlphaStr & " " & LStr
'MsgBox (SurveourString)

End Function

' Define Surveuor string for Arc Segment
Private Function ArcSurveourString(GrText As Graphic, GrArc As Graphic) As String
Dim UppendLenUnit%
    UppendLenUnit = GrText.Properties("UppendLenUnit")
Dim LenUnit$
    LenUnit = GrText.Properties("LenUnit")
    If UppendLenUnit = 0 Then
        LenUnit = ""
    End If
Dim LenPrecision%
    LenPrecision = GrText.Properties("LenPrecision")
Dim FormatString$, i%
    If LenPrecision = 0 Then
        FormatString = "###0"
    Else
        FormatString = "###0."
    End If
    For i = 1 To LenPrecision
        FormatString = FormatString & "0"
    Next i

Dim DrawingUnit$
    DrawingUnit = GrText.Properties("Units")

Dim xc#, yc#, x1#, y1#, x2#, y2#
    With GrArc.Vertices
        xc = .Item(0).X
        yc = .Item(0).y
        x1 = .Item(1).X
        y1 = .Item(1).y
        x2 = .Item(2).X
        y2 = .Item(2).y
    End With
Dim R#, sina#, cosa#, fiBeg#, fiEnd#
    R = Sqr((x1 - xc) * (x1 - xc) + (y1 - yc) * (y1 - yc))
'MsgBox ("l=" & CStr(l))
    sina = (y1 - yc) / R
    cosa = (x1 - xc) / R
    fiBeg = Angle(sina, cosa)
    sina = (y2 - yc) / R
    cosa = (x2 - xc) / R
    fiEnd = Angle(sina, cosa)
    If fiBeg > fiEnd Then fiEnd = fiEnd + 2 * Pi
Dim Beta#
    Beta = fiEnd - fiBeg
Dim L#
    L = R * Beta

Dim BetaSec As Long
    BetaSec = Int(Beta * 180 * 3600 / Pi) ' Angle in second
Dim Deg As Long, Min As Long, Sec As Long, MinSec As Long
    Deg = Int(BetaSec / 3600)
    MinSec = BetaSec - Deg * 3600
    Min = Int(MinSec / 60)
    Sec = Int(MinSec - Min * 60)
Dim DegStr$, MinStr$, SecStr$
    If Deg > 9 Then
        DegStr = CStr(Deg)
    Else
        If Deg = 0 Then
            DegStr = "00"
        Else
            DegStr = "0" & CStr(Deg)
        End If
    End If
    If Min > 9 Then
        MinStr = CStr(Min)
    Else
        If Min = 0 Then
            MinStr = "00"
        Else
            MinStr = "0" & CStr(Min)
        End If
    End If
    If Sec > 9 Then
        SecStr = CStr(Sec)
    Else
        If Sec = 0 Then
            SecStr = "00"
        Else
            SecStr = "0" & CStr(Sec)
        End If
    End If

Dim AlphaStr$
    AlphaStr = DegStr & VBA.Chr(186) & MinStr & "'" & SecStr & """"

Dim RStr$
    RStr = VBA.Format(R, FormatString)

Dim LStr$
    LStr = VBA.Format(L, FormatString)

    RStr = RStr & LenUnit
    LStr = LStr & LenUnit
    ArcSurveourString = AlphaStr & "  R=" & RStr & "  L=" & LStr
'MsgBox (ArcSurveourString)

End Function

' Define Surveuor string for Polyline Segment
Private Function PolylineSurveourString(GrText As Graphic, GrPoly As Graphic, ConVertex As Long) As String
Dim UppendLenUnit%
    UppendLenUnit = GrText.Properties("UppendLenUnit")
Dim LenUnit$
    LenUnit = GrText.Properties("LenUnit")
    If UppendLenUnit = 0 Then
        LenUnit = ""
    End If
Dim LenPrecision%
    LenPrecision = GrText.Properties("LenPrecision")
Dim FormatString$, i%
    If LenPrecision = 0 Then
        FormatString = "###0"
    Else
        FormatString = "###0."
    End If
    For i = 1 To LenPrecision
        FormatString = FormatString & "0"
    Next i

Dim DrawingUnit$
    DrawingUnit = GrText.Properties("Units")

    If GrPoly.Vertices(ConVertex + 1).Bulge = True Then GoTo ARCSEG

'MsgBox ("ConVertex=" & CStr(ConVertex))

' if Line Segment
Dim x0#, y0#, x1#, y1#
    With GrPoly.Vertices
        x0 = .Item(ConVertex).X
        y0 = .Item(ConVertex).y
        x1 = .Item(ConVertex + 1).X
        y1 = .Item(ConVertex + 1).y
    End With
Dim L#, sina#, cosa#, Alpha#
    L = Sqr((x1 - x0) * (x1 - x0) + (y1 - y0) * (y1 - y0))
'MsgBox ("l=" & CStr(l))
    sina = (y1 - y0) / L
    cosa = (x1 - x0) / L
    Alpha = Angle(sina, cosa)
Dim Beta#, Direction$
    If cosa = 0 And sina > 0 Then
        Direction = "NE"
        Beta = 0
        GoTo WW
    End If
    If cosa = 0 And sina < 0 Then
        Direction = "SE"
        Beta = 0
        GoTo WW
    End If
    If cosa > 0 And sina = 0 Then
        Direction = "NE"
        Beta = Pi / 2
        GoTo WW
    End If
    If cosa < 0 And sina = 0 Then
        Direction = "SE"
        Beta = Pi / 2
        GoTo WW
    End If

    If sina > 0 And cosa > 0 Then
        Direction = "NE"
        Beta = Pi / 2 - Alpha
        GoTo WW
    End If
    If sina > 0 And cosa < 0 Then
        Direction = "NW"
        Beta = Alpha - Pi / 2
        GoTo WW
    End If
    If sina < 0 And cosa < 0 Then
        Direction = "SW"
        Beta = 3 * Pi / 2 - Alpha
        GoTo WW
    End If
    If sina < 0 And cosa > 0 Then
        Direction = "SE"
        Beta = Alpha - 3 * Pi / 2
        GoTo WW
    End If
WW:
Dim BetaSec As Long
    BetaSec = Int(Beta * 180 * 3600 / Pi) ' Angle in second
Dim Deg As Long, Min As Long, Sec As Long, MinSec As Long
    Deg = Int(BetaSec / 3600)
    MinSec = BetaSec - Deg * 3600
    Min = Int(MinSec / 60)
    Sec = Int(MinSec - Min * 60)
Dim DegStr$, MinStr$, SecStr$
    If Deg > 9 Then
        DegStr = CStr(Deg)
    Else
        If Deg = 0 Then
            DegStr = "00"
        Else
            DegStr = "0" & CStr(Deg)
        End If
    End If
    If Min > 9 Then
        MinStr = CStr(Min)
    Else
        If Min = 0 Then
            MinStr = "00"
        Else
            MinStr = "0" & CStr(Min)
        End If
    End If
    If Sec > 9 Then
        SecStr = CStr(Sec)
    Else
        If Sec = 0 Then
            SecStr = "00"
        Else
            SecStr = "0" & CStr(Sec)
        End If
    End If

Dim AlphaStr$
    If Direction = "NE" Then
        AlphaStr = "N" & DegStr & VBA.Chr(186) & MinStr & "'" & SecStr & """" & "E"
    End If
    If Direction = "NW" Then
        AlphaStr = "N" & DegStr & VBA.Chr(186) & MinStr & "'" & SecStr & """" & "W"
    End If
    If Direction = "SE" Then
        AlphaStr = "S" & DegStr & VBA.Chr(186) & MinStr & "'" & SecStr & """" & "E"
    End If
    If Direction = "SW" Then
        AlphaStr = "S" & DegStr & VBA.Chr(186) & MinStr & "'" & SecStr & """" & "W"
    End If
Dim LStr$
    LStr = VBA.Format(L, FormatString)

    LStr = LStr & LenUnit
    PolylineSurveourString = AlphaStr & "   " & LStr
'MsgBox (SurveourString)
    Exit Function
ARCSEG:
'##########################################################################
'##########################################################################

'MsgBox ("ConVertex=" & CStr(ConVertex))
Dim xc#, yc#, x1C#, y1C#, x2C#, y2C#, xMidC#, yMidC#, xDir#, yDir#
    With GrPoly.Vertices
        xc = .Item(ConVertex + 1).X
        yc = .Item(ConVertex + 1).y
        x1C = .Item(ConVertex).X
        y1C = .Item(ConVertex).y
        x2C = .Item(ConVertex + 3).X
        y2C = .Item(ConVertex + 3).y
        xDir = .Item(ConVertex + 2).X
        yDir = .Item(ConVertex + 2).y
    End With
'Define current Arc-segment and middle point on it

Dim R#, fiBegC#, fiEndC#, fiMidC#
    R = Sqr((x1C - xc) * (x1C - xc) + (y1C - yc) * (y1C - yc))
Dim Rot%
    Rot = ArcRotation(x1C, y1C, xDir, yDir, xc, yc, R)
    Call ArcMiddlePoint(xc, yc, x1C, y1C, x2C, y2C, R, -Rot, xMidC, yMidC)

'MsgBox ("l=" & CStr(l))
    sina = (y1C - yc) / R
    cosa = (x1C - xc) / R
    fiBegC = Angle(sina, cosa)
    sina = (y2C - yc) / R
    cosa = (x2C - xc) / R
    fiEndC = Angle(sina, cosa)
    sina = (yMidC - yc) / R
    cosa = (xMidC - xc) / R
    fiMidC = Angle(sina, cosa)
    If (fiMidC > fiBegC And fiMidC < fiEndC) Or (fiMidC > fiEndC And fiMidC < fiBegC) Then
        Beta = Abs(fiEndC - fiBegC)
    Else
        If fiBegC > fiEndC Then
            fiEndC = fiEndC + 2 * Pi
            Beta = Abs(fiEndC - fiBegC)
        Else
            fiBegC = fiBegC + 2 * Pi
            Beta = Abs(fiEndC - fiBegC)
        End If
    End If

'    If fiBeg > fiEnd Then fiEnd = fiEnd + 2 * Pi
'    Beta = fiEnd - fiBeg
'Dim L#
    L = R * Beta

    BetaSec = Int(Beta * 180 * 3600 / Pi) ' Angle in second
    Deg = Int(BetaSec / 3600)
    MinSec = BetaSec - Deg * 3600
    Min = Int(MinSec / 60)
    Sec = Int(MinSec - Min * 60)
    If Deg > 9 Then
        DegStr = CStr(Deg)
    Else
        If Deg = 0 Then
            DegStr = "00"
        Else
            DegStr = "0" & CStr(Deg)
        End If
    End If
    If Min > 9 Then
        MinStr = CStr(Min)
    Else
        If Min = 0 Then
            MinStr = "00"
        Else
            MinStr = "0" & CStr(Min)
        End If
    End If
    If Sec > 9 Then
        SecStr = CStr(Sec)
    Else
        If Sec = 0 Then
            SecStr = "00"
        Else
            SecStr = "0" & CStr(Sec)
        End If
    End If

    AlphaStr = DegStr & VBA.Chr(186) & MinStr & "'" & SecStr & """"

Dim RStr$
    RStr = VBA.Format(R, FormatString)
    LStr = VBA.Format(L, FormatString)
    RStr = RStr & LenUnit
    LStr = LStr & LenUnit
    PolylineSurveourString = AlphaStr & " R=" & RStr & " L=" & LStr
'MsgBox (PolylineSurveourString)

End Function

' Update the text along connected Polyline with arc segments

Private Sub TextAlongPolyline(Gr As Graphic, GrPoly As Graphic, GrText As Graphic, SurvText As String, HText#, LText#, xcText#, yCText#, ConVertex As Long)
'MsgBox ("TextAlongLine")
Dim i As Long
Dim TextLocation%
    TextLocation = Gr.Properties("TextLocation")
Dim TextGap#
    TextGap = Gr.Properties("TextGap")
'Dim ConVertex As Long
'    ConVertex = Gr.Properties("ConVertex")
    If ConVertex = -1 Then ConVertex = 0
Dim GrConIDOld As Long
    GrConIDOld = Gr.Properties("GrConIDOld")

    If GrPoly.Vertices(ConVertex + 1).Bulge = True Then GoTo ARCSEG
 ' If text connected to line segment
'############################################################
    ' Define the geometry parameters of Connected line
'############################################################
    ' Define the geometry parameters of Connected line
Dim x0L#, y0L#, x1L#, y1L#
        With GrPoly.Vertices
            x0L = .Item(ConVertex).X
            y0L = .Item(ConVertex).y
            x1L = .Item(ConVertex + 1).X
            y1L = .Item(ConVertex + 1).y
        End With
Dim lL#, sinaL#, cosaL#
Dim AlphaL#
        lL = Sqr((x1L - x0L) * (x1L - x0L) + (y1L - y0L) * (y1L - y0L))
        sinaL = (y1L - y0L) / lL
        cosaL = (x1L - x0L) / lL
        AlphaL = Angle(sinaL, cosaL)
'############################################################

Dim xLoc0#, yLoc0#, xLoc1#, yLoc1#, xLoc2#, yLoc2#
Dim x0#, y0#, x1#, y1#, x2#, y2#
        With Gr.Vertices
            x0 = .Item(0).X ' Center point of the text
            y0 = .Item(0).y
        End With

' Begin If first connection text to line
        GrConIDOld = Gr.Properties("GrConIDOld")
        If GrConIDOld = -1 Or lL < LText Then
            x0 = (x1L + x0L) / 2
            y0 = (y1L + y0L) / 2
            xLoc1 = lL / 2 - LText / 2
            yLoc1 = 0
            xLoc2 = lL / 2 + LText / 2
            yLoc2 = 0
            xLoc0 = lL / 2
            yLoc0 = 0
' End If first connection text to line
        Else
            xLoc0 = (y0 - y0L) * sinaL + (x0 - x0L) * cosaL
            xLoc1 = xLoc0 - LText / 2
            xLoc2 = xLoc0 + LText / 2
            If xLoc1 < 0 Then
                xLoc0 = LText / 2
                xLoc1 = 0
                xLoc2 = LText
            End If
            If xLoc2 > lL Then
                xLoc0 = lL - LText / 2
                xLoc1 = lL - LText
                xLoc2 = lL
            End If

        End If
        x1 = x0L + xLoc1 * cosaL - yLoc1 * sinaL
        y1 = y0L + xLoc1 * sinaL + yLoc1 * cosaL

        x2 = x0L + xLoc2 * cosaL - yLoc2 * sinaL
        y2 = y0L + xLoc2 * sinaL + yLoc2 * cosaL

'########################################################################
        If TextLocation = 1 Then ' If text above line
            If cosaL < -0.01 Then
                yLoc0 = -HText / 2 - TextGap
            Else
                yLoc0 = HText / 2 + TextGap
            End If
        End If
        If TextLocation = 0 Then ' If text Middle line
            yLoc0 = 0 + TextGap
        End If
        If TextLocation = -1 Then ' If text Middle line
            If cosaL < -0.01 Then
                yLoc0 = HText / 2 + TextGap
            Else
                yLoc0 = -HText / 2 - TextGap
            End If
        End If
        yLoc1 = yLoc0
        yLoc2 = yLoc0

'########################################################################
        'new coordinates for the Base Text vertices
        x0 = x0L + xLoc0 * cosaL - yLoc0 * sinaL
        y0 = y0L + xLoc0 * sinaL + yLoc0 * cosaL

        x1 = x0L + xLoc1 * cosaL - yLoc1 * sinaL
        y1 = y0L + xLoc1 * sinaL + yLoc1 * cosaL

        x2 = x0L + xLoc2 * cosaL - yLoc2 * sinaL
        y2 = y0L + xLoc2 * sinaL + yLoc2 * cosaL

' Begin examine the location of the limits text vertices
Dim sina#, cosa#, xTem#, yTem#, L#
Dim Alpha#
        L = Sqr((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1))
        sina = (y2 - y1) / L
        cosa = (x2 - x1) / L
        Alpha = Angle(sina, cosa)
        If cosa < -0.01 Then
'MsgBox ("Alpha=" & CStr(Alpha * 180 / Pi) & "  cosa=" & CStr(cosa))
            xTem = x1
            yTem = y1
            x1 = x2
            y1 = y2
            x2 = xTem
            y2 = yTem
            xTem = xLoc1
            xLoc1 = xLoc2
            xLoc2 = xTem
            Alpha = Alpha + Pi
        End If
' End examine the location of the limits text vertices
'MsgBox ("AlongLine x0=" & CStr(x0) & " y0=" & CStr(y0))

        With Gr.Vertices
            .Item(0).X = x0
            .Item(0).y = y0
            .Item(1).X = x1
            .Item(1).y = y1
            .Item(2).X = x2
            .Item(2).y = y2
        End With
        ' correct location of the center child graphic

' locate text between 2 limits vertices
    GrText.RotateAxis Alpha, 0, 0, 1, xcText, yCText, 0
    GrText.MoveRelative x0 - xcText, y0 - yCText, 0

      Exit Sub
ARCSEG:

    GrText.Deleted = True
Dim xc#, yc#, xBC#, yBC#, xEC#, yEC#, xMidC#, yMidC#, xDir#, yDir#
    With GrPoly.Vertices
        xc = .Item(ConVertex + 1).X
        yc = .Item(ConVertex + 1).y
        xBC = .Item(ConVertex).X
        yBC = .Item(ConVertex).y
        xEC = .Item(ConVertex + 3).X
        yEC = .Item(ConVertex + 3).y
        xDir = .Item(ConVertex + 2).X
        yDir = .Item(ConVertex + 2).y
    End With
'Define current Arc-segment and middle point on it

Dim R#
    R = Sqr((xBC - xc) * (xBC - xc) + (yBC - yc) * (yBC - yc))
Dim Rot%
    Rot = ArcRotation(xBC, yBC, xDir, yDir, xc, yc, R)
    Call ArcMiddlePoint(xc, yc, xBC, yBC, xEC, yEC, R, Rot, xMidC, yMidC)
Dim Dictinct%
    Dictinct = ArcDictinct(xBC, yBC, xEC, yEC, xMidC, yMidC, Rot)
'MsgBox ("Rot=" & CStr(Rot) & " xMidC=" & CStr(xMidC) & " yMidC=" & CStr(yMidC))
'MsgBox ("Rot=" & CStr(Rot) & "  Dictinct=" & CStr(Dictinct))

Dim GrCirc As Graphic
    If Rot = -1 Then
        Set GrCirc = Gr.Graphics.AddArcTriplePoint(xBC, yBC, 0, xMidC, yMidC, 0, xEC, yEC, 0)
    Else
        Set GrCirc = Gr.Graphics.AddArcTriplePoint(xEC, yEC, 0, xMidC, yMidC, 0, xBC, yBC, 0)
    End If
'MsgBox ("Rot=" & CStr(Rot) & "  Dictinct=" & CStr(Dictinct))
    Call TextAlongCircle(Gr, GrCirc, SurvText, HText, Dictinct)
    GrCirc.Deleted = True
    Set GrCirc = Nothing

End Sub

' Define the middle point of Base Arc
' from Beg-End Points and Rot
' Rot=1 - Counter Clockwise
' Rot=-1 - Clockwise
Private Sub ArcMiddlePoint(xc As Double, yc As Double, xB As Double, yB As Double, xE As Double, yE As Double, R As Double, Rot As Integer, xmid As Double, ymid As Double)
    If Abs(R) < Eps Then
        xmid = xc
        ymid = yc
        Exit Sub
    End If

Dim sina#, cosa#
Dim fiBeg#, fiEnd#, fiMid#
    sina = (yB - yc) / R
    cosa = (xB - xc) / R
    fiBeg = Angle(sina, cosa)

    sina = (yE - yc) / R
    cosa = (xE - xc) / R
    fiEnd = Angle(sina, cosa)

    If Rot = 1 Then ' Counter Clockwise
        If fiBeg > fiEnd Then fiEnd = fiEnd - 2 * Pi
    Else    'Clockwise
        If fiBeg < fiEnd Then fiEnd = fiEnd - 2 * Pi
    End If

    fiMid = (fiBeg + fiEnd) / 2
    xmid = xc + R * Cos(fiMid)
    ymid = yc + R * Sin(fiMid)

End Sub

' Define the direction of Arc rotation
' return ArcRotation = 1 if CounterClockwise
' return ArcRotation = -1 if Clockwise

Private Function ArcRotation(xB As Double, yB As Double, xDir As Double, yDir As Double, xc As Double, yc As Double, R As Double) As Integer
Dim sina#, cosa# ', Alp0#, Alp1#
    sina = (yB - yc) / R
    cosa = (xB - xc) / R
Dim xLoc#, yLoc#
    xLoc = (yDir - yc) * sina + (xDir - xc) * cosa
    yLoc = (yDir - yc) * cosa - (xDir - xc) * sina
    If yLoc > 0 Then
        ArcRotation = 1
    Else
        ArcRotation = -1
    End If
End Function

' Define distinct of Arc
Private Function ArcDictinct(xB As Double, yB As Double, xE As Double, yE As Double, xj As Double, yj As Double, Rot As Integer) As Integer
Dim sina#, cosa#, Alp#, L#
Dim yLoc#
    L = Sqr((xE - xB) * (xE - xB) + (yE - yB) * (yE - yB))
    sina = (yE - yB) / L
    cosa = (xE - xB) / L
    yLoc = (yj - yB) * cosa - (xj - xB) * sina
    If Rot = -1 Then
        If yLoc > 0 Then
            ArcDictinct = 1
        Else
            ArcDictinct = -1
        End If
    End If
    If Rot = 1 Then
        If yLoc > 0 Then
            ArcDictinct = -1
        Else
            ArcDictinct = 1
        End If
    End If

End Function

Private Function ConnectionExist(Gr As Graphic, GrConID As Long, TieWasted As Boolean) As Long
    ConnectionExist = GrConID
'MsgBox ("ConnectionExist grID=" & CStr(Gr.ID))
Dim TSets As TieSets
Dim TSet As TieSet
    TieWasted = True
    On Error GoTo ErrHandler
    Set TSets = Gr.Drawing.TieSets
    Set TSet = Nothing
    On Error Resume Next
    Set TSet = TSets.TieSet(GrConID, Gr.ID)
    If TSet Is Nothing Then
        ConnectionExist = -1
    Else
        TieWasted = TSet.Flag(imsiTieWasted)
    End If
    Set TSet = Nothing
    Set TSets = Nothing
    Exit Function
ErrHandler:
'    MsgBox "Error: " + Err.Description
    Set TSet = Nothing
    Set TSets = Nothing
End Function


Examples - Surveyor Dimension Tool - SurvReg.frm

SurvReg.frm

Surveyor Dimension Tool Example

VERSION 5.00
Begin VB.Form frmSurvReg
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Text Properties"
   ClientHeight    =   5280
   ClientLeft      =   6420
   ClientTop       =   2895
   ClientWidth     =   5550
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   5280
   ScaleWidth      =   5550
   Begin VB.TextBox Suffix
      Height          =   288
      Left            =   3120
      TabIndex        =   23
      Top             =   720
      Width           =   1332
   End
   Begin VB.TextBox Preffix
      Height          =   288
      Left            =   1080
      TabIndex        =   21
      Top             =   720
      Width           =   1332
   End
   Begin VB.CheckBox Link
      Caption         =   "Associative Dimension"
      Height          =   252
      Left            =   240
      TabIndex        =   20
      Top             =   4080
      Width           =   2052
   End
   Begin VB.TextBox LenPrecision
      Height          =   288
      Left            =   3840
      TabIndex        =   18
      Text            =   "2"
      Top             =   3480
      Width           =   372
   End
   Begin VB.VScrollBar VScroll1
      Height          =   288
      Left            =   4200
      Max             =   10
      TabIndex        =   17
      Top             =   3480
      Width           =   252
   End
   Begin VB.ComboBox LenUnits
      Height          =   288
      ItemData        =   "SurvReg.frx":0000
      Left            =   2160
      List            =   "SurvReg.frx":0022
      TabIndex        =   15
      Text            =   "in"
      Top             =   3480
      Width           =   612
   End
   Begin VB.CheckBox UppendLenUnits
      Caption         =   "Uppend Units"
      Height          =   252
      Left            =   240
      TabIndex        =   14
      Top             =   3480
      Width           =   1332
   End
   Begin VB.TextBox TextGap
      Height          =   288
      Left            =   3000
      TabIndex        =   12
      Text            =   "Text1"
      Top             =   2640
      Width           =   1212
   End
   Begin VB.ComboBox FontText
      Height          =   288
      Left            =   2640
      TabIndex        =   7
      Text            =   "Times New Roman"
      Top             =   1800
      Width           =   2292
   End
   Begin VB.TextBox HeightText
      Height          =   288
      Left            =   840
      TabIndex        =   5
      Text            =   "0.2"
      Top             =   1800
      Width           =   1092
   End
   Begin VB.ComboBox Location
      Height          =   288
      ItemData        =   "SurvReg.frx":004B
      Left            =   960
      List            =   "SurvReg.frx":0055
      TabIndex        =   3
      Text            =   "Above"
      Top             =   2640
      Width           =   1092
   End
   Begin VB.TextBox SurvText
      Height          =   288
      Left            =   1080
      TabIndex        =   2
      Top             =   240
      Width           =   3372
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   720
      TabIndex        =   0
      Top             =   4680
      Width           =   1335
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   2760
      TabIndex        =   1
      Top             =   4680
      Width           =   1332
   End
   Begin VB.Label Label12
      AutoSize        =   -1  'True
      Caption         =   "Text"
      Height          =   192
      Left            =   600
      TabIndex        =   25
      Top             =   240
      Width           =   312
   End
   Begin VB.Label Label11
      AutoSize        =   -1  'True
      Caption         =   "Suffix"
      Height          =   192
      Left            =   2640
      TabIndex        =   24
      Top             =   720
      Width           =   372
   End
   Begin VB.Label Label10
      AutoSize        =   -1  'True
      Caption         =   "Preffix"
      Height          =   192
      Left            =   480
      TabIndex        =   22
      Top             =   720
      Width           =   432
   End
   Begin VB.Label Label9
      AutoSize        =   -1  'True
      Caption         =   "Precision"
      Height          =   192
      Left            =   3120
      TabIndex        =   19
      Top             =   3480
      Width           =   672
   End
   Begin VB.Label Label8
      AutoSize        =   -1  'True
      Caption         =   "Units"
      Height          =   192
      Left            =   1680
      TabIndex        =   16
      Top             =   3480
      Width           =   360
   End
   Begin VB.Label Label7
      AutoSize        =   -1  'True
      Caption         =   "Primary Unts"
      Height          =   192
      Left            =   240
      TabIndex        =   13
      Top             =   3120
      Width           =   912
   End
   Begin VB.Line Line3
      BorderWidth     =   2
      X1              =   1440
      X2              =   4920
      Y1              =   3240
      Y2              =   3240
   End
   Begin VB.Label Label6
      AutoSize        =   -1  'True
      Caption         =   "TextGap"
      Height          =   192
      Left            =   2280
      TabIndex        =   11
      Top             =   2640
      Width           =   624
   End
   Begin VB.Label Label5
      Caption         =   "Text Position"
      Height          =   252
      Left            =   240
      TabIndex        =   10
      Top             =   2280
      Width           =   1092
   End
   Begin VB.Line Line2
      BorderWidth     =   2
      X1              =   1440
      X2              =   4920
      Y1              =   2400
      Y2              =   2400
   End
   Begin VB.Label Label4
      AutoSize        =   -1  'True
      Caption         =   "Font"
      Height          =   192
      Left            =   2160
      TabIndex        =   9
      Top             =   1800
      Width           =   312
   End
   Begin VB.Label Label3
      AutoSize        =   -1  'True
      Caption         =   "Text"
      Height          =   192
      Left            =   240
      TabIndex        =   8
      Top             =   1440
      Width           =   312
   End
   Begin VB.Line Line1
      BorderWidth     =   2
      X1              =   840
      X2              =   4920
      Y1              =   1560
      Y2              =   1560
   End
   Begin VB.Label Label2
      AutoSize        =   -1  'True
      Caption         =   "Height"
      Height          =   192
      Left            =   240
      TabIndex        =   6
      Top             =   1800
      Width           =   468
   End
   Begin VB.Label Label1
      AutoSize        =   -1  'True
      Caption         =   "Vertical"
      Height          =   192
      Left            =   240
      TabIndex        =   4
      Top             =   2640
      Width           =   540
   End
End
Attribute VB_Name = "frmSurvReg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
    Me.Hide
End Sub

Private Sub Form_Load()
    With frmSurvReg.FontText
        .AddItem ("Arial")
        .AddItem ("Arial Baltic")
        .AddItem ("Arial Black")
        .AddItem ("Arial CE")
        .AddItem ("Arial CYR")
        .AddItem ("Arial Greek")
        .AddItem ("Arial Narrow")
        .AddItem ("Arial TUR")

        .AddItem ("BankGothic Lt BT")
        .AddItem ("BankGothic Md BT")
        .AddItem ("Bookman Old Style")
        .AddItem ("Bookshelf Symbol 1")
        .AddItem ("Bookshelf Symbol 2")
        .AddItem ("Bookshelf Symbol 3")

        .AddItem ("CityBlueprint")
        .AddItem ("Comic Sans MS")
        .AddItem ("CommercialPi BT")
        .AddItem ("CommercialScript BT")
        .AddItem ("Complex")
        .AddItem ("complex.shx")
        .AddItem ("CountryBlueprint")

        .AddItem ("Courier New")
        .AddItem ("Courier New Baltic")
        .AddItem ("Courier New CE")
        .AddItem ("Courier New CYR")
        .AddItem ("Courier New Greek")
        .AddItem ("Courier New TUR")

        .AddItem ("Dutch801 Rm BT")
        .AddItem ("Dutch801 XBd BT")

        .AddItem ("EuroRoman")

        .AddItem ("FractionsRoman")
        .AddItem ("FractionsSans")

        .AddItem ("Garamond")
        .AddItem ("GDT")
        .AddItem ("gdt.shx")
        .AddItem ("GothicE")
        .AddItem ("gothice.shx")
        .AddItem ("GothicG")
        .AddItem ("gothicg.shx")
        .AddItem ("GothicI")
        .AddItem ("gothici.shx")

        .AddItem ("GreekC")
        .AddItem ("greekc.shx")
        .AddItem ("GreekS")
        .AddItem ("greeks.shx")

        .AddItem ("Impact")
        .AddItem ("ISOCP")
        .AddItem ("isocp.shx")
        .AddItem ("ISOCP2")
        .AddItem ("isocp2.shx")
        .AddItem ("ISOCP3")
        .AddItem ("isocp3.shx")
        .AddItem ("ISOCPEUR")

        .AddItem ("ISOCT")
        .AddItem ("isoct.shx")
        .AddItem ("ISOCT2")
        .AddItem ("isoct2.shx")
        .AddItem ("ISOCT3")
        .AddItem ("isoct3.shx")
        .AddItem ("ISOCTEUR")

        .AddItem ("Italic")
        .AddItem ("italic.shx")
        .AddItem ("ItalicC")
        .AddItem ("italicc.shx")
        .AddItem ("ItalicT")
        .AddItem ("italict.shx")

        .AddItem ("LetterGothic")
        .AddItem ("Lucida Concole")

        .AddItem ("Marlett")
        .AddItem ("Monotxt")
        .AddItem ("monotxt.shx")
        .AddItem ("MS Outlook")

        .AddItem ("PanRoman")
        .AddItem ("Proxy 1")
        .AddItem ("Proxy 2")
        .AddItem ("Proxy 3")
        .AddItem ("Proxy 4")
        .AddItem ("Proxy 5")
        .AddItem ("Proxy 6")
        .AddItem ("Proxy 7")
        .AddItem ("Proxy 8")
        .AddItem ("Proxy 9")

        .AddItem ("RomanC")
        .AddItem ("romanc.shx")
        .AddItem ("RomanD")
        .AddItem ("romand.shx")
        .AddItem ("RomanS")
        .AddItem ("romans.shx")
        .AddItem ("RomanT")
        .AddItem ("romant.shx")

        .AddItem ("SansSerif")

        .AddItem ("ScriptC")
        .AddItem ("scriptc.shx")
        .AddItem ("ScriptS")
        .AddItem ("scripts.shx")

        .AddItem ("Simplex")
        .AddItem ("simplex.shx")

        .AddItem ("Swis 721 Blk BT")

        .AddItem ("Symap")
        .AddItem ("Symath")
        .AddItem ("Symbol")

        .AddItem ("Tahoma")
        .AddItem ("Technic")
        .AddItem ("TechnicBold")
        .AddItem ("TechnicLite")

        .AddItem ("Times New Roman")
        .AddItem ("Times New Roman Baltic")
        .AddItem ("Times New Roman CE")
        .AddItem ("Times New Roman CYR")
        .AddItem ("Times New Roman Greek")
        .AddItem ("Times New Roman TUR")

        .AddItem ("Txt")
        .AddItem ("txt.shx")

        .AddItem ("Vendana")
        .AddItem ("Webdings")

    End With
End Sub

Private Sub VScroll1_Change()
    LenPrecision.Text = VScroll1.Value
End Sub


Examples - Surveyor Dimension Tool - SurvTie.cls

SurvTie.cls

Surveyor Dimension Tool Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "CoordTie"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Implements ITurboCADSmartTieServer

Private Declare Function TCWDrawingActive Lib "TCAPI70.dll" () As Long
Private Declare Function TCWGraphicAt Lib "TCAPI70.dll" (ByVal d As Long, ByVal Index As Long) As Long
Private Declare Function TCWVertexAt Lib "TCAPI70.dll" (ByVal g As Long, ByVal Index As Long) As Long

Private Declare Sub prVertexSetSomeFlags Lib "DBAPI70.dll" (ByVal hVer As Long, ByVal FlagOn As Long, ByVal FlagOff As Long)

Private Declare Function GraphicGetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long) As Long
Private Declare Function GraphicSetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long, ByVal hMat As Long) As Boolean
Private Declare Function MatrixEqual Lib "DBAPI70.dll" (ByVal hM1 As Long, ByVal hM2 As Long) As Boolean

'Useful math constants
Const Pi# = 3.14159265
Const Eps = 0.000001

Public Type VertexTieData
    TypeSeg As Integer  ' 1 - Line
                        ' 2 - Arc
                        ' 3 - ArcSegment
    xLocRelPrev As Double ' Previous local coordinate on line segment
    fiLocRelPrev As Double  ' Previous Angle coordinate on Arc segment

    ConVerCount As Long     ' count of vertex on base Graphic
    ConVertex As Long  ' Connected Vertex
    NumSegment As Long  ' Connected Segment
    CoordSum As Double ' sum of Coordinates
End Type

Private idVTie As String

Private TSets As TieSets
Private TSet  As TieSet
Private Tie   As Tie
Private ActDr   As Drawing
Private tieData As VertexTieData

Private VersSbj As Vertices
Private VersSbd As Vertices

Private Grs   As Graphics
Private GrSbj As Graphic
Private GrSbd As Graphic

Private hDr As Long
Private hGrSurText As Long
Private hGrBaseLine As Long
Private hMatSurText As Long
Private hMatBaseLine As Long

Private Function Clear()

    Set VersSbj = Nothing
    Set VersSbd = Nothing

    Set GrSbj = Nothing
    Set GrSbd = Nothing
    Set Grs = Nothing
    Set Tie = Nothing
    Set TSet = Nothing
    Set TSets = Nothing
    Set ActDr = Nothing

End Function

Private Function ITurboCADSmartTieServer_AddTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, ByVal lType As Long) As Boolean
'MsgBox ("AddTie")
Dim varData As Variant
    Set ActDr = pIDispDwg
    Set GrSbj = Nothing
    Set GrSbd = Nothing
    Set GrSbj = ActDr.Graphics.GraphicFromID(idSbj)
    Set GrSbd = ActDr.Graphics.GraphicFromID(idSbd)
Dim GrText As Graphic
Dim GrCon As Graphic
    If GrSbj.Type = "Surveying.CoordReg" Then
        Set GrText = GrSbj
        Set GrCon = GrSbd
    Else
        Set GrText = GrSbd
        Set GrCon = GrSbj
    End If

Dim ConVerCount As Long, CoordSum#
    CoordSum = 0
Dim i As Long, xi#, yi#
    With GrCon.Vertices
        ConVerCount = .Count
        For i = 0 To ConVerCount - 1
            xi = .Item(i).X
            yi = .Item(i).Y
            CoordSum = CoordSum + xi + yi
        Next i
    End With

Dim ConVertex As Long
    ConVertex = GrText.Properties("ConVertex")
    ConVertex = lType

Dim NumSegment As Long
    NumSegment = 0
Dim GrConType$
    GrConType = GrCon.Type
Dim TypeSeg%
    TypeSeg = 1
    If GrConType = "ARC" Then
        TypeSeg = 2     ' Arc
        NumSegment = 1
    Else
        If GrCon.Vertices(ConVertex + 1).Bulge = False Then
            TypeSeg = 1 ' Line segment
        Else
            TypeSeg = 3 ' Arc segment
        End If
        If GrConType = "GRAPHIC" Then
            NumSegment = ConVertex
        Else
Dim Vers As Vertices
Dim Ver As Vertex
Dim VerNext As Vertex

            Set Vers = GrCon.Vertices
            NumSegment = 0
            i = 0
            Set Ver = Vers(i)
            Set VerNext = Vers(i)
            If i = ConVertex Then
                NumSegment = NumSegment + 1
                GoTo LEND
            End If
            If VerNext.Bulge = False Then
                i = i + 1
                NumSegment = NumSegment + 1
                If i = ConVerCount - 1 Then GoTo LEND
            Else
                i = i + 3
                NumSegment = NumSegment + 1
                If i = ConVerCount - 1 Then GoTo LEND
            End If
LEND:
        End If
    End If

Dim x0#, y0#
Dim xB#, yB#, xE#, yE#, xc#, yc#, xDir#, yDir#, xMid#, yMid#
Dim L#, sina#, cosa#, x0Loc#, y0Loc#, R#
Dim xLocRelPrev#
    xLocRelPrev = 0
    With GrText.Vertices
        x0 = .Item(0).X
        y0 = .Item(0).Y
    End With

    If TypeSeg = 1 Then ' Line segm
        With GrCon.Vertices
            xB = .Item(ConVertex).X
            yB = .Item(ConVertex).Y
            xE = .Item(ConVertex + 1).X
            yE = .Item(ConVertex + 1).Y
        End With
        L = Sqr((xE - xB) * (xE - xB) + (yE - yB) * (yE - yB))
        sina = (yE - yB) / L
        cosa = (xE - xB) / L
        x0Loc = (y0 - yB) * sina + (x0 - xB) * cosa
        xLocRelPrev = x0Loc
    End If

Dim fiB#, fiE#, fi0#
Dim fiBLoc#, fiELoc#, fi0Loc#
Dim fiLocRelPrev#
    fiLocRelPrev = 0
    If TypeSeg = 2 Then ' Arc
        With GrCon.Vertices
            xc = .Item(0).X
            yc = .Item(0).Y
            xB = .Item(1).X
            yB = .Item(1).Y
            xE = .Item(2).X
            yE = .Item(2).Y
            xDir = .Item(3).X
            yDir = .Item(3).Y
        End With
        R = Sqr((xB - xc) * (xB - xc) + (yB - yc) * (yB - yc))
        sina = (yB - yc) / R
        cosa = (xB - xc) / R
        fiB = Angle(sina, cosa)
        sina = (yE - yc) / R
        cosa = (xE - xc) / R
        fiE = Angle(sina, cosa)

        If fiB - fiE > Eps Then fiB = fiB - 2 * Pi

        sina = (y0 - yc) / R
        cosa = (x0 - xc) / R
        fi0 = Angle(sina, cosa)

        fiBLoc = fiB - fiB
        fiELoc = fiE - fiB
        fi0Loc = fi0 - fiB
        fiLocRelPrev = fi0Loc
    End If
    If TypeSeg = 3 Then ' Arc segment
        With GrCon.Vertices
            xc = .Item(ConVertex + 1).X
            yc = .Item(ConVertex + 1).Y
            xB = .Item(ConVertex).X
            yB = .Item(ConVertex).Y
            xE = .Item(ConVertex + 3).X
            yE = .Item(ConVertex + 3).Y
            xDir = .Item(ConVertex + 2).X
            yDir = .Item(ConVertex + 2).Y
        End With
        R = Sqr((xB - xc) * (xB - xc) + (yB - yc) * (yB - yc))
Dim Rot%
        Rot = ArcRotation(xB, yB, xDir, yDir, xc, yc, R)
        sina = (yB - yc) / R
        cosa = (xB - xc) / R
        fiB = Angle(sina, cosa)
        sina = (yE - yc) / R
        cosa = (xE - xc) / R
        fiE = Angle(sina, cosa)

        If fiB - fiE > Eps Then fiB = fiB - 2 * Pi

        sina = (y0 - yc) / R
        cosa = (x0 - xc) / R
        fi0 = Angle(sina, cosa)

        fiBLoc = fiB - fiB
        fiELoc = fiE - fiB
        fi0Loc = fi0 - fiB
        fiLocRelPrev = fi0Loc

    End If
    Set TSets = ActDr.TieSets
    Set TSet = TSets.TieSet(idSbj, idSbd)
        tieData.ConVerCount = ConVerCount
        tieData.CoordSum = CoordSum
        tieData.fiLocRelPrev = fiLocRelPrev
        tieData.TypeSeg = TypeSeg
        tieData.xLocRelPrev = xLocRelPrev
        tieData.ConVertex = ConVertex
        tieData.NumSegment = NumSegment
        varData = tieData
        TSet.AddTie idVTie, 1, varData

    Set TSet = TSets.TieSet(idSbd, idSbj)
        tieData.ConVerCount = ConVerCount
        tieData.CoordSum = CoordSum
        tieData.fiLocRelPrev = fiLocRelPrev
        tieData.TypeSeg = TypeSeg
        tieData.xLocRelPrev = xLocRelPrev
        tieData.ConVertex = ConVertex
        tieData.NumSegment = NumSegment
        varData = tieData
        TSet.AddTie idVTie, 1, varData
        varData = tieData
        TSet.AddTie idVTie, 1, varData

        Set GrText = Nothing
        Set GrCon = Nothing
    ITurboCADSmartTieServer_AddTie = True
    Clear

End Function

Private Function ITurboCADSmartTieServer_CopyTie(ByVal pIDispDwg As Object, ByVal idSbjSrc As Long, ByVal idSbdSrc As Long, ByVal idSbjTrg As Long, ByVal idSbdTrg As Long) As Boolean

    Set ActDr = pIDispDwg
    Set Grs = ActDr.Graphics
    Set GrSbj = Grs.GraphicFromID(idSbjTrg)
    Set GrSbd = Grs.GraphicFromID(idSbdTrg)

    Set TSets = ActDr.TieSets
    Set TSet = TSets.TieSet(idSbjSrc, idSbdSrc)
    Set Tie = TSet(0)
    tieData = Tie.Data

'    TSets.Add idVTie, GrSbj, GrSbd, tieData.idVrtSbj, 0, TSet

    Set Tie = TSet(0)
    Tie.Data = tieData

    Clear

    ITurboCADSmartTieServer_CopyTie = True
End Function

Private Function ITurboCADSmartTieServer_DeleteTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, ByVal pIDsipGr As Object) As Boolean
    ITurboCADSmartTieServer_DeleteTie = True
End Function

Private Property Get ITurboCADSmartTieServer_Description() As String
    ITurboCADSmartTieServer_Description = "CurveText_Tie"
End Property

Private Function ITurboCADSmartTieServer_GetIDs(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Variant
' It is not need to do something here because this method doesn't use Graphic's DataBase ID
End Function

Private Function ITurboCADSmartTieServer_GetTypesInfo(Names As Variant, Types As Variant) As Long
    ITurboCADSmartTieServer_GetTypesInfo = 0
End Function

Private Function ITurboCADSmartTieServer_Initialize(ByVal ThisTieMethod As Object) As Boolean
    Dim gxTMethod As TieMethod
    Set gxTMethod = ThisTieMethod
    idVTie = gxTMethod.Name
    ITurboCADSmartTieServer_Initialize = True
End Function

Private Sub ITurboCADSmartTieServer_SetIDs(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, pvarIDs As Variant)
' It is not need to do something here because this method doesn't use Graphic's DataBase ID
End Sub

Private Function ITurboCADSmartTieServer_TieCanNODEED(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Boolean
    ITurboCADSmartTieServer_TieCanNODEED = True
End Function

Private Function ITurboCADSmartTieServer_UpdateTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Integer

    Set ActDr = pIDispDwg

    Set TSets = ActDr.TieSets
    Set TSet = TSets.TieSet(idSbj, idSbd)

    UpdateTie TSet, TSets, idSbj, idSbd

    ITurboCADSmartTieServer_UpdateTie = 0
    Clear

End Function

Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function

' Define the direction of Arc rotation
' return ArcRotation = 1 if CounterClockwise
' return ArcRotation = -1 if Clockwise

Private Function ArcRotation(xB As Double, yB As Double, xDir As Double, yDir As Double, xc As Double, yc As Double, R As Double) As Integer
Dim sina#, cosa# ', Alp0#, Alp1#
    sina = (yB - yc) / R
    cosa = (xB - xc) / R
Dim xLoc#, yLoc#
    xLoc = (yDir - yc) * sina + (xDir - xc) * cosa
    yLoc = (yDir - yc) * cosa - (xDir - xc) * sina
    If yLoc > 0 Then
        ArcRotation = -1
    Else
        ArcRotation = 1
    End If
End Function

Private Function UpdateTie(ByRef TSet As TieSet, ByRef TSets As TieSets, ByVal idSbj As Long, ByVal idSbd As Long)

    Dim varData As Variant
    Set ActDr = TSets.Drawing
    Set GrSbj = Nothing
    Set GrSbd = Nothing
    Set GrSbj = ActDr.Graphics.GraphicFromID(idSbj)
    Set GrSbd = ActDr.Graphics.GraphicFromID(idSbd)
Dim GrText As Graphic
Dim GrCon As Graphic
Dim EditGr$
    If GrSbj.Type = "Surveying.CoordReg" Then
        Set GrText = GrSbj
        Set GrCon = GrSbd
        EditGr = "Text"
    Else
        Set GrText = GrSbd
        Set GrCon = GrSbj
        EditGr = "Base"
    End If

    Set Tie = TSet(0)
    varData = Tie.Data
    tieData = varData(0)

Dim ConVerCount As Long, CoordSum#, fiLocRelPrev#, TypeSeg%, xLocRelPrev#
Dim ConVertex As Long, NumSegment As Long
    ConVerCount = tieData.ConVerCount
    CoordSum = tieData.CoordSum
    fiLocRelPrev = tieData.fiLocRelPrev
    TypeSeg = tieData.TypeSeg
    xLocRelPrev = tieData.xLocRelPrev
    ConVertex = tieData.ConVertex
    NumSegment = tieData.NumSegment

    '#################################################################
    '#################################################################
    '#################################################################
    ' if was edited - TEXT
    ConVertex = GrText.Properties("ConVertex")
Dim Ver As Vertex
Dim VerNext As Vertex
Dim x0#, y0#
Dim xB#, yB#, xE#, yE#, xc#, yc#, xDir#, yDir#, xMid#, yMid#
Dim L#, sina#, cosa#, x0Loc#, y0Loc#, R#

    If EditGr = "Text" Then
        Set Ver = Nothing
        On Error Resume Next
        Set Ver = GrCon.Vertices(ConVertex)
        If Ver Is Nothing Then
            GoTo QQQ
        End If

        Set VerNext = Nothing
        On Error Resume Next
        Set VerNext = GrCon.Vertices(ConVertex + 1)
        If VerNext Is Nothing Then
            GoTo QQQ
        End If

'Dim xmax#, ymax#, xmin#, ymin#
'        With GrText.CalcBoundingBox
'            xmax = .Max.X
'            ymax = .Max.Y
'            xmin = .Min.X
'            ymin = .Min.Y
'        End With
' Dim GrRect As Graphic
'        Set GrRect = ActDr.Graphics.Add(11)
'        With GrRect.Vertices
'            .Add xmin, ymin, 0
'            .Add xmax, ymin, 0
'            .Add xmax, ymax, 0
'            .Add xmin, ymax, 0
'            .AddClose
'        End With
'        GrRect.Properties("PenColor") = RGB(255, 255, 255)
'        GrRect.Draw

'        GrText.Properties("GrConID") = GrCon.ID

'        GrText.Update
'        GrText.Draw
'        GrRect.Deleted = True

        If GrCon.Type = "ARC" Then
            TypeSeg = 2
        Else
            If VerNext.Bulge = True Then
                TypeSeg = 3
            Else
                TypeSeg = 1
            End If
        End If

        With GrText.Vertices
            x0 = .Item(0).X
            y0 = .Item(0).Y
        End With
        ' ***********************************************************

        If TypeSeg = 1 Then
            With GrCon.Vertices
                xB = .Item(ConVertex).X
                yB = .Item(ConVertex).Y
                xE = .Item(ConVertex + 1).X
                yE = .Item(ConVertex + 1).Y
            End With
            L = Sqr((xE - xB) * (xE - xB) + (yE - yB) * (yE - yB))
            sina = (yE - yB) / L
            cosa = (xE - xB) / L
            x0Loc = (y0 - yB) * sina + (x0 - xB) * cosa
            xLocRelPrev = x0Loc
        End If
        ' ***********************************************************
Dim fiB#, fiE#, fi0#
Dim fiBLoc#, fiELoc#, fi0Loc#
        If TypeSeg = 2 Then ' Arc
            With GrCon.Vertices
                xc = .Item(0).X
                yc = .Item(0).Y
                xB = .Item(1).X
                yB = .Item(1).Y
                xE = .Item(2).X
                yE = .Item(2).Y
                xDir = .Item(3).X
                yDir = .Item(3).Y
            End With
            R = Sqr((xB - xc) * (xB - xc) + (yB - yc) * (yB - yc))
            sina = (yB - yc) / R
            cosa = (xB - xc) / R
            fiB = Angle(sina, cosa)
            sina = (yE - yc) / R
            cosa = (xE - xc) / R
            fiE = Angle(sina, cosa)

            If fiB - fiE > Eps Then fiB = fiB - 2 * Pi

            sina = (y0 - yc) / R
            cosa = (x0 - xc) / R
            fi0 = Angle(sina, cosa)

            fiBLoc = fiB - fiB
            fiELoc = fiE - fiB
            fi0Loc = fi0 - fiB
            fiLocRelPrev = fi0Loc
        End If
        ' ***********************************************************
        If TypeSeg = 3 Then ' Arc segment
            With GrCon.Vertices
                xc = .Item(ConVertex + 1).X
                yc = .Item(ConVertex + 1).Y
                xB = .Item(ConVertex).X
                yB = .Item(ConVertex).Y
                xE = .Item(ConVertex + 3).X
                yE = .Item(ConVertex + 3).Y
                xDir = .Item(ConVertex + 2).X
                yDir = .Item(ConVertex + 2).Y
            End With
            R = Sqr((xB - xc) * (xB - xc) + (yB - yc) * (yB - yc))
Dim Rot%
            Rot = ArcRotation(xB, yB, xDir, yDir, xc, yc, R)
            sina = (yB - yc) / R
            cosa = (xB - xc) / R
            fiB = Angle(sina, cosa)
            sina = (yE - yc) / R
            cosa = (xE - xc) / R
            fiE = Angle(sina, cosa)

            If fiB - fiE > Eps Then fiB = fiB - 2 * Pi

            sina = (y0 - yc) / R
            cosa = (x0 - xc) / R
            fi0 = Angle(sina, cosa)

            fiBLoc = fiB - fiB
            fiELoc = fiE - fiB
            fi0Loc = fi0 - fiB
            fiLocRelPrev = fi0Loc
        End If

        ' Write New Data into TSet Structures
        Set TSets = ActDr.TieSets
        Set TSet = TSets.TieSet(idSbj, idSbd)
            tieData.ConVerCount = ConVerCount
            tieData.CoordSum = CoordSum
            tieData.fiLocRelPrev = fiLocRelPrev
            tieData.TypeSeg = TypeSeg
            tieData.xLocRelPrev = xLocRelPrev
            tieData.ConVertex = ConVertex
            tieData.NumSegment = NumSegment
            varData = tieData
            TSet.AddTie idVTie, 1, varData

        Set TSet = TSets.TieSet(idSbd, idSbj)
            tieData.ConVerCount = ConVerCount
            tieData.CoordSum = CoordSum
            tieData.fiLocRelPrev = fiLocRelPrev
            tieData.TypeSeg = TypeSeg
            tieData.xLocRelPrev = xLocRelPrev
            tieData.ConVertex = ConVertex
            tieData.NumSegment = NumSegment
            varData = tieData
            TSet.AddTie idVTie, 1, varData
    End If
    '#################################################################
    '#################################################################
    '#################################################################

    '#################################################################
    '#################################################################
    '#################################################################
    ' if was edited - BASE-graphic

    If EditGr = "Base" Then
        Set Ver = Nothing
        On Error Resume Next
        Set Ver = GrCon.Vertices(ConVertex)
        If Ver Is Nothing Then
            GoTo QQQ
        End If
        Set VerNext = Nothing
        On Error Resume Next
        Set VerNext = GrCon.Vertices(ConVertex + 1)
        If VerNext Is Nothing Then
            GoTo QQQ
        End If
Dim xmax#, ymax#, xmin#, ymin#
        With GrText.CalcBoundingBox
            xmax = .Max.X
            ymax = .Max.Y
            xmin = .Min.X
            ymin = .Min.Y
        End With
 Dim GrRect As Graphic
        Set GrRect = ActDr.Graphics.Add(11)
        With GrRect.Vertices
            .Add xmin, ymin, 0
            .Add xmax, ymin, 0
            .Add xmax, ymax, 0
            .Add xmin, ymax, 0
            .AddClose
        End With
        GrRect.Properties("PenColor") = RGB(255, 255, 255)
        GrRect.Draw

        If GrCon.Type = "ARC" Then
            TypeSeg = 2
        Else
            If VerNext.Bulge = True Then
                TypeSeg = 3
            Else
                TypeSeg = 1
            End If
        End If

        With GrText.Vertices
            x0 = .Item(0).X
            y0 = .Item(0).Y
        End With

        ' ***********************************************************
        If TypeSeg = 1 Then
            With GrCon.Vertices
                xB = .Item(ConVertex).X
                yB = .Item(ConVertex).Y
                xE = .Item(ConVertex + 1).X
                yE = .Item(ConVertex + 1).Y
            End With
            L = Sqr((xE - xB) * (xE - xB) + (yE - yB) * (yE - yB))
            sina = (yE - yB) / L
            cosa = (xE - xB) / L

            x0Loc = xLocRelPrev
            y0Loc = 0
            x0 = xB + x0Loc * cosa - y0Loc * sina
            y0 = yB + x0Loc * sina + y0Loc * cosa
            With GrText.Vertices
                .Item(0).X = x0
                .Item(0).Y = y0
            End With
            GrText.Update
            GrText.Draw
        End If
        ' *******************************************************
        If TypeSeg = 2 Then ' Arc
            With GrCon.Vertices
                xc = .Item(0).X
                yc = .Item(0).Y
                xB = .Item(1).X
                yB = .Item(1).Y
            End With
            R = Sqr((xB - xc) * (xB - xc) + (yB - yc) * (yB - yc))
            sina = (yB - yc) / R
            cosa = (xB - xc) / R
            fiB = Angle(sina, cosa)

            If fiB - fiE > Eps Then fiB = fiB - 2 * Pi

            fi0 = fiB + fiLocRelPrev

            x0 = xc + R * Cos(fi0)
            y0 = yc + R * Sin(fi0)
            With GrText.Vertices
                .Item(0).X = x0
                .Item(0).Y = y0
            End With
            GrText.Update
            GrText.Draw
        End If
        ' ***********************************************************
        If TypeSeg = 3 Then ' Arc segment
            With GrCon.Vertices
                xc = .Item(ConVertex + 1).X
                yc = .Item(ConVertex + 1).Y
                xB = .Item(ConVertex).X
                yB = .Item(ConVertex).Y
                xE = .Item(ConVertex + 3).X
                yE = .Item(ConVertex + 3).Y
                xDir = .Item(ConVertex + 2).X
                yDir = .Item(ConVertex + 2).Y
            End With
            R = Sqr((xB - xc) * (xB - xc) + (yB - yc) * (yB - yc))
            Rot = ArcRotation(xB, yB, xDir, yDir, xc, yc, R)
            sina = (yB - yc) / R
            cosa = (xB - xc) / R
            fiB = Angle(sina, cosa)

            If fiB - fiE > Eps Then fiB = fiB - 2 * Pi

            fi0 = fiB + fiLocRelPrev

            x0 = xc + R * Cos(fi0)
            y0 = yc + R * Sin(fi0)
            With GrText.Vertices
                .Item(0).X = x0
                .Item(0).Y = y0
            End With
            GrText.Update
            GrText.Draw

        End If
        GrRect.Deleted = True

    End If

QQQ:
'    GrText.Properties("GrConID") = -1
'    GrText.Draw
    Set GrText = Nothing
    Set GrCon = Nothing
End Function


Examples - Text Along Curve Tool - clsToolTextAlong.cls

clsToolTextAlong.cls

Text Along Curve Tool Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Contour"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'Number of tools in this server
Const NUM_TOOLS = 1

' *******************************************************************
'    Const EventMask = 268435456 + 536870912
'    Const EventMask = 1024 + 268435456 + 536870912
    Const EventMask = 1 + 2 + 4 + 8 + 16 + 32 + 64 + 1024 + 4096 + 262144 + 268435456 + 536870912

    Private iConnectId As Long
    Private iActTool As Long
    Private theToolEvents As IToolEvents

' *******************************************************************
'Toggle this to test loading buttons from .Bmp/.Res
Const boolLoadFromBmp As Boolean = False
Const boolDebug As Boolean = False
'##########################################################################
'##########################################################################
Private Declare Function TCWUndoClear Lib "TCAPI70.dll" () As Long
Private Declare Function TCWUndoRecordEnd Lib "TCAPI70.dll" (ByVal d As Long) As Long
Private Declare Function TCWUndoRecordStart Lib "TCAPI70.dll" (ByVal d As Long, ByRef Title As String) As Long
Private Declare Function TCWUndoRecordAddGraphic Lib "TCAPI70.dll" (ByVal d As Long, ByVal g As Long) As Long
Private Declare Function TCWUndo Lib "TCAPI70.dll" (ByVal N As Long) As Long

Private Declare Function TCWDrawingActive Lib "TCAPI70.dll" () As Long
Private Declare Function TCWGraphicAt Lib "TCAPI70.dll" (ByVal d As Long, ByVal Index As Long) As Long
Private Declare Function TCWVertexAt Lib "TCAPI70.dll" (ByVal g As Long, ByVal Index As Long) As Long

Private Declare Sub prVertexSetSomeFlags Lib "DBAPI70.dll" (ByVal hVer As Long, ByVal FlagOn As Long, ByVal FlagOff As Long)

Private Declare Function GraphicGetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long) As Long
Private Declare Function GraphicSetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long, ByVal hMat As Long) As Boolean
Private Declare Function MatrixEqual Lib "DBAPI70.dll" (ByVal hM1 As Long, ByVal hM2 As Long) As Boolean

Private Declare Function TCWViewRedraw Lib "TCAPI70.dll" () As Long

Private hDr As Long
Private GrCon As Graphic

Type VertexTieData
    idVertPoly As Long ' define the least nearest index of segment's vertex on polygon
    xLocRelPrev As Double ' Previous local coordinate on line segment
    AnglePrev As Double ' Previous angle of line segment
    fiMidPrev As Double ' Previous angle for middle text point for Circle or Arc
    xcPrev As Double    ' Previous Xc for Circle or Arc
    ycPrev As Double    ' Previous Yc for Circle or Arc
    LFullPrev As Double     ' Previous full length for Curve or TCW50Polyline
    x0Prev As Double    ' Previous x0 for Curve or TCW50Polyline
    y0Prev As Double    ' Previous y0 for Curve or TCW50Polyline
    x1Prev As Double    ' Previous x1 for Curve or TCW50Polyline
    y1Prev As Double    ' Previous y1 for Curve or TCW50Polyline
    L0RelPrev As Double  ' Previous relative Length coordinate for the center vertex of the text
    L1RelPrev As Double ' Previous relative Length coordinate for the first bounded vertex of the text
    L2RelPrev As Double ' Previous relative Length coordinate for the first bounded vertex of the text
End Type

'Copy a windows bitmap of the requested size to the clipboard
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire bitmap:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono bitmap should be 1-bit (black or white)
Public Function CopyBitmap(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Boolean
    On Error GoTo BitmapError

    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        'Put the image on the Windows clipboard
        Clipboard.SetData TheImage, vbCFDIB
        CopyBitmap = True
        Exit Function
    End If

BitmapError:
    CopyBitmap = False
End Function

'Return a Picture object for the requested size
'Apparently, returning references to StdPicture objects doesn't work for .EXE servers
'Bitmaps returned should contain NUM_TOOLS images
'Size of entire image:
'Normal:  (NUM_TOOLS*16) wide x 15 high
'Large:   (NUM_TOOLS*24) wide x 23 high
'Mono image should be 1-bit (black or white)
Public Function GetPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean) As Object
    On Error GoTo PictureError

    Dim TheImage As New StdPicture
    If GetButtonPicture(LargeImage, MonoImage, TheImage) Then
        Set GetPicture = TheImage
        Exit Function
    End If

PictureError:
    Set GetPicture = Nothing
End Function

'Implementation specific stuff
'Private function to return the bitmap from .Res file or .Bmp file
Private Function GetButtonPicture(ByVal LargeImage As Boolean, ByVal MonoImage As Boolean, TheImage As StdPicture) As Boolean
    On Error GoTo LoadError

    'There are two ways to load images:  from .Bmp file(s) or from .RES resource.
    'In this demo, we control the loading by a private variable.

    'Note that if you are loading from .Bmp, or if you are running this tool as a
    '.VBP for debugging, you must place the .Res or .Bmp files in the Draggers subdirectory
    'of the directory in which TCW40.EXE (or IMSIGX40.DLL) is located.

    If boolLoadFromBmp Then
        'Load from .Bmp file
        Dim strFileName As String 'File name of .Bmp file to load

        If LargeImage Then
            strFileName = App.Path & "\button24.bmp"
        Else
            strFileName = App.Path & "\button16.bmp"
        End If
        Set TheImage = LoadPicture(strFileName)
    Else
        'Load from .Res file
        Dim idBitmap%  'BITMAP resource id in .Res file

        If LargeImage Then
            idBitmap% = 1002
        Else
            idBitmap% = 1001
        End If
        Set TheImage = LoadResPicture(idBitmap%, vbResBitmap)
    End If

    'Return the image
    GetButtonPicture = True
    Exit Function

LoadError:
    If boolDebug Then
'        MsgBox "Error loading bitmap: " & Err.Description
    End If
    GetButtonPicture = False
End Function

'##########################################################################
'##########################################################################
'##########################################################################

'Return a description string for this package of tools
Public Property Get Description() As String
    Description = "TextAlongCurve"
End Property

'Called to perform tool function
Public Function Run(ByVal Tool As Object) As Boolean
    On Error GoTo ErrorHandler
Dim theXTool As Tool
    Set theXTool = Tool
'    theXTool.Application.ActiveDrawing.Graphics.Unselect

    Set GrCon = Nothing
    If iConnectId <> -1 Then
        objApp.DisconnectEvents iConnectId
        AddLM False
        iConnectId = -1
        iActTool = -1
        theToolEvents.ToolChangePrompt Me, "", False
    Else
        theToolEvents.ToolChangePrompt Me, "", False
        iConnectId = objApp.ConnectEvents(Me, EventMask)
        iActTool = theXTool.Index
        AddLM True
        theToolEvents.ToolChangePrompt Me, "Select a graphic", False
    End If

    Exit Function
ErrorHandler:
'    MsgBox Err.Msg
    Call Finish
End Function

'Fill arrays with information about tools in the package
'Return the number of tools in the package
Public Function GetToolInfo(CommandNames As Variant, MenuCaptions As Variant, StatusPrompts As Variant, _
    ToolTips As Variant, Enabled As Variant, WantsUpdates As Variant) As Long

    ReDim CommandNames(NUM_TOOLS)
    ReDim MenuCaptions(NUM_TOOLS, 2)
    ReDim StatusPrompts(NUM_TOOLS)
    ReDim ToolTips(NUM_TOOLS)
    ReDim Enabled(NUM_TOOLS)
    ReDim WantsUpdates(NUM_TOOLS)
    CommandNames(0) = "S&DK|&Insert|TextAlongCurve"
    MenuCaptions(0, 0) = "&TextAlongCurve"
    MenuCaptions(0, 1) = "SDK" 'toolbar name
    ToolTips(0) = "TextAlongCurve"
    Enabled(0) = True
    WantsUpdates(0) = False
    GetToolInfo = NUM_TOOLS
End Function

'Returns true if tool is correctly initialized
Public Function Initialize(ByVal Tool As Object) As Boolean
On Error GoTo ErrorHandler
    Set objApp = Tool.Application
    Set theToolEvents = objApp
    iConnectId = -1
    iActTool = -1
    Initialize = True
    Exit Function
ErrorHandler:
 '   MsgBox Err.Description
End Function

'Returns true if tool is correctly initialized
Public Function UpdateToolStatus(ByVal Tool As Object, Enabled As Boolean, Checked As Boolean) As Boolean
    Enabled = True 'Could do a test here to determine whether to disable the button/menu item
    If iConnectId = -1 Then
        Checked = False  'Could do a test here to determine whether to check the button/menu item
    Else
        Checked = True
    End If
    UpdateToolStatus = True
End Function

Public Function RunTool(WhichTool As Tool)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function

Public Function BeforeExit(WhichApplication As Application, Cancel As Boolean)
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    Call Finish

End Function
Public Function DrawingNew(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False

    Call Finish
End Function
Public Function DrawingOpen(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function
Public Function DrawingActivate(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function
Public Function DrawingDeactivate(WhichDrawing As Drawing)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function
Public Function DrawingBeforeClose(WhichDrawing As Drawing, Cancel As Boolean)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    AddLM False
    Call Finish
End Function
Public Function DrawingBeforeSave(WhichDrawing As Drawing, SaveAs As Boolean, Cancel As Boolean)
    On Error Resume Next
    theToolEvents.ToolChangePrompt Me, "", False  '????
    objApp.DisconnectEvents iConnectId       '????
    iConnectId = -1       '????
    Call Finish
End Function

Public Function MouseDown(WhichDrawing As Drawing, WhichView As View, WhichWindow As Window, Button As ImsiMouseButton, Shift As Long, x As Long, y As Long, Cancel As Boolean)
Dim xView#, yView#
On Error GoTo ErrorHandler
    Set Drs = objApp.Drawings
    Set ActDr = WhichDrawing
    Set Grs = ActDr.Graphics
    Set Vis = ActDr.Views
    Set Vi = WhichView
    hDr = TCWDrawingActive
Dim Res As Integer
    Vi.ScreenToView x, y, xView, yView

    If Button = imsiLeftButton Then
        Cancel = True
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
        Res = SelectCurve(xView, yView)
        If Res = 0 Or Res = 1 Then
            If GrCon Is Nothing Then
                Beep
                MsgBox "The object is not selected. Please,try to select it again.", , "Text Along Curve"
            Else
                Beep
                MsgBox "The selection object is not valid for this operation.", , "Text Along Curve"
                GrCon.Properties("Selected") = False
                GrCon.Draw
            End If
            theToolEvents.ToolChangePrompt Me, "", False
            theToolEvents.ToolChangePrompt Me, "Select a graphic", False
            Exit Function
        End If
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

        If iConnectId <> -1 Then
            theToolEvents.ToolChangePrompt Me, "", False
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
            AddLM False
        End If
        Cancel = True
        Call Finish
    Else
        Cancel = False
    End If
'    Call Finish
    Exit Function
ErrorHandler:
    If iConnectId <> -1 Then
        theToolEvents.ToolChangePrompt Me, "", False
        objApp.DisconnectEvents iConnectId
        iConnectId = -1
        AddLM False
    End If
    Call Finish
 '   MsgBox Err.Description
End Function

Public Function Cancel(DoItPlease As Boolean, CanCancel As Boolean)
    If (DoItPlease) Then
        If iConnectId <> -1 Then
            theToolEvents.ToolChangePrompt Me, "", False
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
        End If

        theToolEvents.ToolChangePrompt Me, "", False
        Call Finish
    End If

    CanCancel = True
End Function

Public Function UpdateUndo(AllowsUndo As Boolean)
    AllowsUndo = False
End Function

Private Function AddActToolLM(iTool As Long, bAdd As Boolean)
'    AddLM bAdd
End Function
Private Sub Class_Terminate()
    If (Not theToolEvents Is Nothing) Then
        Set theToolEvents = Nothing
    End If
    If (Not objApp Is Nothing) Then
        Set objApp = Nothing
    End If

End Sub

Private Function AddLM(bAdd As Boolean)
Dim Captions(0 To 0) As String
Dim Prompts(0 To 0) As String
Dim Enabled(0 To 0) As Boolean
Dim Checked(0 To 0) As Boolean

Dim varCaptions As Variant
Dim varPrompts As Variant
Dim varEnabled As Variant
Dim varChecked As Variant

    If (bAdd) Then
        Captions(0) = "Finish TextAlongCurve"
        Prompts(0) = "Finish TextAlongCurve"
        Enabled(0) = True
        Checked(0) = True
        varCaptions = Captions
        varPrompts = Prompts
        varEnabled = Enabled
        varChecked = Checked

        theToolEvents.ToolChangeCommands Me, 1, varCaptions, varPrompts, varEnabled, varChecked, True
    Else
        theToolEvents.ToolChangeCommands Me, 0, , , , , False
    End If
End Function

Public Function DoLMCommand(CmdInd As Long)
'MsgBox ("CmdInd=" & CStr(CmdInd))
   If CmdInd = 0 Then
         If iConnectId <> -1 Then
            objApp.DisconnectEvents iConnectId
            iConnectId = -1
            AddLM False
        End If
        theToolEvents.ToolChangePrompt Me, "", False

        Call Finish
'        Set objApp = Nothing

    End If

End Function
Private Sub Finish()
    Set GrCon = Nothing
    Set Grs = Nothing
    Set Vi = Nothing
    Set Vis = Nothing
    Set ActDr = Nothing
    Set Drs = Nothing
 '   Set objApp = Nothing
End Sub

'########################################################################
'########################################################################
'########################################################################
' Select Curve at Mouse click

Private Function SelectCurve(xCl As Double, yCl As Double) As Integer
On Error GoTo ErrorHandler
    Set GrCon = Nothing

Dim PicRes As PickResult
Dim PicCount As Long
    ActDr.Application.SnapModes = 256 ' Nearest to graphic
    Set PicRes = Vi.PickPoint(xCl, yCl)
    PicCount = PicRes.Count

    If PicCount = 0 Then
        ActDr.Application.SnapModes = 1 ' Nearest to graphic
        SelectCurve = 0 ' There are no objects in pick point
        Set PicRes = Nothing
        Exit Function
    End If

    Set GrCon = PicRes(0).Graphic
    GrCon.Properties("Selected") = True
    GrCon.Draw

Dim GrConType$, GrConID As Long
    GrConType = GrCon.Type
    If GrConType = "GRAPHIC" And GrCon.Graphics.Count > 0 Then
        ActDr.Application.SnapModes = 1 ' Nearest to graphic
        SelectCurve = 1 ' Clicked graphic can't take part in operation
        Set PicRes = Nothing
        Exit Function
    End If
    If GrConType = "GRAPHIC" And ActDr.Properties("TileMode") = 1 Then
Dim Thick1#
        Thick1 = -1000000#
        On Error Resume Next
        Thick1 = GrCon.Properties("Thickness")
        If Thick1 = -1000000 Then ' For 3D-Polyline
            ActDr.Application.SnapModes = 1 ' Nearest to graphic
            SelectCurve = 1 ' Clicked graphic can't take part in operation
            Set PicRes = Nothing
            Exit Function
        End If
    End If
    If GrConType = "TCW50Polyline" Then
'MsgBox (GrCon.Graphics(0).Name)
        If GrCon.Graphics(0).Name = "ChildWithWidth" Or GrCon.Graphics(0).Name = "Line_Width_Cosmetic" Then
            ActDr.Application.SnapModes = 1 ' Nearest to graphic
            SelectCurve = 1 ' Clicked graphic can't take part in operation
            Set PicRes = Nothing
            Exit Function
        End If
    End If

    If GrConType = "GRAPHIC" Or GrConType = "CIRCLE" Or GrConType = "ARC" Or GrConType = "TCW30CURVE" Or GrConType = "TCW50Polyline" Then
        GrConID = GrCon.ID
    Else
        ActDr.Application.SnapModes = 1 ' Nearest to graphic
        SelectCurve = 1  ' Clicked graphic can't take part in operation
        Set PicRes = Nothing
        Exit Function
    End If
' ######################################################
Dim GrTem As Graphic
    Set GrTem = Grs.Add(11)
    GrTem.Vertices.Add 0, 0, 0
    GrTem.Vertices.Add 1, 0, 0, False
    GrTem.Draw

Dim GrText As Graphic
    Set GrText = Grs.Add(, "TextAlong.Curve")
'###############################################################
Dim MyText$
Dim Location%
Dim TextLocation$
Dim SurvCoord%
Dim HeightText#
Dim Thick#
Dim InvertSym%
Dim TextOffset#

Dim StyleText%
Dim ModeText%
Dim FontText$
    Load frmToolTextAlong
        With GrText.Properties
            MyText = .Item("MyText")
            Location = .Item("TextLocation")
            HeightText = .Item("HeightText")
            Thick = .Item("Thick")
            InvertSym = .Item("InvertSym")
            TextOffset = .Item("TextOffset")
            StyleText = .Item("StyleText")
            ModeText = .Item("ModeText")
            FontText = .Item("FontText")
        End With

        With frmToolTextAlong
            .MyText.Text = MyText

            If Location = 1 Then .Location.Text = "Above"
            If Location = 0 Then .Location.Text = "Middle"
            If Location = -1 Then .Location.Text = "Bottom"

            .HeightText.Text = CStr(HeightText)
            .Thick.Text = CStr(Thick)
            .InvertSym.Value = InvertSym
            .TextOffset.Text = CStr(TextOffset)

            If StyleText = 0 Then .StyleText.Text = "Regular"
            If StyleText = 1 Then .StyleText.Text = "Italic"
            If StyleText = 2 Then .StyleText.Text = "Bold"
            If StyleText = 3 Then .StyleText.Text = "Bold Italic"

            If ModeText = 1 Then .ModeText.Text = "Standard"
            If ModeText = 2 Then .ModeText.Text = "Scalable"
            If ModeText = 3 Then .ModeText.Text = "Flexible"

            .FontText.Text = FontText

        End With

        frmToolTextAlong.Show 1
        If FormCancel = True Then
            GrCon.Properties("Selected") = False
            GrCon.Draw
            ActDr.Application.SnapModes = 1 ' Nearest to graphic
            SelectCurve = 2 ' Form was canceled
            GrText.Deleted = True
            GrTem.Deleted = True
            Set GrTem = Nothing
            Set GrCon = Nothing
           Set GrText = Nothing
            Set PicRes = Nothing
            Exit Function
        End If

            With frmToolTextAlong
                MyText = .MyText.Text
                GrText.Properties("MyText") = MyText

                TextLocation = .Location.Text
                If TextLocation = "Above" Then Location = 1
                If TextLocation = "Middle" Then Location = 0
                If TextLocation = "Bottom" Then Location = -1
                GrText.Properties("TextLocation") = Location

                HeightText = CDbl(.HeightText.Text)
                GrText.Properties("HeightText") = HeightText

                Thick = CDbl(.Thick.Text)
                GrText.Properties("Thick") = Thick

                InvertSym = CInt(.InvertSym.Value)
                GrText.Properties("InvertSym") = InvertSym

                TextOffset = CDbl(.TextOffset.Text)
                GrText.Properties("TextOffset") = TextOffset

                If .StyleText.Text = "Regular" Then GrText.Properties("StyleText") = 0
                If .StyleText.Text = "Italic" Then GrText.Properties("StyleText") = 1
                If .StyleText.Text = "Bold" Then GrText.Properties("StyleText") = 2
                If .StyleText.Text = "Bold Italic" Then GrText.Properties("StyleText") = 3

                If .ModeText.Text = "Standard" Then GrText.Properties("ModeText") = 1
                If .ModeText.Text = "Scalable" Then GrText.Properties("ModeText") = 2
                If .ModeText.Text = "Flexible" Then GrText.Properties("ModeText") = 3

                GrText.Properties("FontText") = .FontText.Text
            End With

'###############################################################

Dim hGrText As Long
    hGrText = TCWGraphicAt(hDr, GrText.Index)
    TCWUndoRecordStart hDr, "Add TextAlongCurve"
    TCWUndoRecordAddGraphic hDr, hGrText
    TCWUndoRecordEnd hDr

Dim hGrCon As Long, hMat As Long
    hGrCon = TCWGraphicAt(hDr, GrCon.Index)
    hMat = GraphicGetMatrix(hGrCon)
    GraphicSetMatrix hGrText, hMat

Dim xPic#, yPic#
Dim Ver As Vertex
        Set Ver = PicRes(0).ClosestVertex
        xPic = Ver.x
        yPic = Ver.y

    GrText.Properties("GrConID") = GrConID
    GrText.Properties("GrConType") = GrConType
    GrText.Properties("PenColor") = GrCon.Properties("PenColor")
    GrText.Update

Dim TSets As TieSets
Dim TSet As TieSet
    Set TSet = Nothing
    On Error Resume Next
    Set TSets = ActDr.TieSets
    On Error Resume Next
    Set TSet = TSets.TieSet(GrCon.ID, GrText.ID)

    If TSet Is Nothing Then
        TSets.Add "Curve.TextTie", GrCon, GrText, 0, 0
    End If

    With GrText.Vertices
        .Item(0).x = xPic
        .Item(0).y = yPic
    End With
   GrText.Update

'###################################################################
'###################################################################
' Write New data into Tie data
        Call UpdateTie1(GrCon, GrText, TSets)

'###################################################################
'###################################################################

    ActDr.Application.SnapModes = 1 ' Nearest to graphic
    GrTem.Deleted = True
    GrCon.Properties("Selected") = False
    GrCon.Draw

    GrText.Draw
    Set GrText = Nothing
    Set GrTem = Nothing
    Set GrCon = Nothing
    Set PicRes = Nothing
    Set TSet = Nothing
    Set TSets = Nothing
    SelectCurve = True

    Exit Function
ErrorHandler:
    Set GrCon = Nothing
    Set GrText = Nothing
    Set PicRes = Nothing
    Set TSet = Nothing
    Set TSets = Nothing
    SelectCurve = False
    ActDr.Application.SnapModes = 1 ' Nearest to graphic

End Function

' Update Tie after moving center vertex of Text
Private Sub UpdateTie1(GrCon As Graphic, GrText As Graphic, TSets As TieSets)
Dim idSbj As Long, idSbd As Long
    idSbj = GrCon.ID
    idSbd = GrText.ID
'###############################################################
Dim TSet As TieSet
    Set TSet = TSets.TieSet(idSbj, idSbd)
Dim TSet1 As TieSet
    Set TSet1 = TSets.TieSet(idSbd, idSbj)
Dim varData As Variant
Dim Tie As Tie
    Set Tie = TSet(0)
    varData = Tie.Data
Dim varData1 As Variant
Dim Tie1 As Tie
    Set Tie1 = TSet1(0)
    varData1 = Tie1.Data

Dim xLoc0Text#, yLoc0Text#, AnglePrev#, ConVertex As Long, xLoc0RelText#
Dim fiMidPrev#, xcPrev#, ycPrev#
Dim LFullPrev#, x0Prev#, y0Prev#, x1Prev#, y1Prev#, L0RelPrev#, L1RelPrev#, L2RelPrev#

    ConVertex = varData(0).idVertPoly
    AnglePrev = varData(0).AnglePrev
    xLoc0RelText = varData(0).xLocRelPrev

    fiMidPrev = varData(0).fiMidPrev
    xcPrev = varData(0).xcPrev
    ycPrev = varData(0).ycPrev

    LFullPrev = varData(0).LFullPrev     ' for Curve or TCW50Polyline
    x0Prev = varData(0).x0Prev     ' for Curve or TCW50Polyline
    y0Prev = varData(0).y0Prev     ' for Curve or TCW50Polyline
    x1Prev = varData(0).x1Prev     ' for Curve or TCW50Polyline
    y1Prev = varData(0).y1Prev     ' for Curve or TCW50Polyline
    L0RelPrev = varData(0).L0RelPrev     ' for Curve or TCW50Polyline
    L1RelPrev = varData(0).L1RelPrev    ' for Curve or TCW50Polyline
    L2RelPrev = varData(0).L2RelPrev    ' for Curve or TCW50Polyline
'MsgBox ("LFullPrev=" & CStr(LFullPrev) & "  L0RelPrev=" & CStr(L0RelPrev))
'#################################################################
Dim GrConType$
    GrConType = GrCon.Type
        If GrConType = "GRAPHIC" Or GrConType = "CIRCLE" Or GrConType = "ARC" Or GrConType = "TCW30CURVE" Or GrConType = "TCW50Polyline" Then
Dim GrCosm As Graphic
            If GrConType = "TCW30CURVE" Then
                Set GrCosm = GrCon.Graphics(1)
            End If
            If GrConType = "TCW50Polyline" Then
                Set GrCosm = GrCon.Graphics(0)
            End If
            If (GrConType = "CIRCLE" And GrCon.Unbounded = False) Or GrConType = "ARC" Then
                Set GrCosm = GrCon.Duplicate
                If GrCon.Drawing.Properties("TileMode") = 1 Then
                    GrCosm.Properties("Thickness") = 0
                    GrCosm.Update
                End If
                GrCosm.Properties("BrushStyle") = ""
                GrCosm.Update
                GrCon.Drawing.Graphics.Remove GrCosm.Index
                Set GrCosm = GrCosm.Explode(0)
            End If

Dim nVCosm As Long, i As Long
            If GrCon.Unbounded = True And GrConType = "CIRCLE" Then
                nVCosm = 50
            Else
                If GrConType = "GRAPHIC" Then
                    nVCosm = GrCon.Vertices.Count
                Else
                    nVCosm = GrCosm.Vertices.Count
                End If
            End If
Dim CurInfo As CosmInfo
ReDim CurInfo.dL(nVCosm + 5)
ReDim CurInfo.lCur(nVCosm + 5)
ReDim CurInfo.xVer(nVCosm + 5)
ReDim CurInfo.yVer(nVCosm + 5)
ReDim CurInfo.Bet(nVCosm + 5)
            If GrCon.Unbounded = True And GrConType = "CIRCLE" Then
                Call FormConCircStruct(GrCon, CurInfo, LFullPrev)
            Else
                If GrConType = "GRAPHIC" Then
                    Call FormCosmStruct(GrCon, CurInfo, LFullPrev)
                Else
                    Call FormCosmStruct(GrCosm, CurInfo, LFullPrev)
                End If

                If GrConType = "CIRCLE" Or GrConType = "ARC" Then
                    GrCosm.Deleted = True
                End If
            End If

            If GrConType = "CIRCLE" Then
                With GrCon.Vertices
                    x0Prev = .Item(0).x
                    y0Prev = .Item(0).y
                    x1Prev = .Item(1).x
                    y1Prev = .Item(1).y
                End With
            Else
                x0Prev = CurInfo.xVer(0)
                y0Prev = CurInfo.yVer(0)
                x1Prev = CurInfo.xVer(1)
                y1Prev = CurInfo.yVer(1)
            End If
Dim x0#, y0#, x1#, y1#, x2#, y2#
        ' Define parameters for TextAlongCurve
            With GrText.Vertices
                x0 = .Item(0).x
                y0 = .Item(0).y
                x1 = .Item(1).x
                y1 = .Item(1).y
                x2 = .Item(2).x
                y2 = .Item(2).y
            End With
Dim L0#, L1#, L2#
Dim iMin As Long, xLocMin#
            Call NumSegmByXY(CurInfo, x0, y0, iMin, L0, xLocMin)
            Call NumSegmByXY(CurInfo, x1, y1, iMin, L1, xLocMin)
            Call NumSegmByXY(CurInfo, x2, y2, iMin, L2, xLocMin)
            L0RelPrev = L0 / LFullPrev
            L1RelPrev = L1 / LFullPrev
            L2RelPrev = L2 / LFullPrev
'MsgBox ("Edit Text L0Rel=" & CStr(L0RelPrev) & "  L1Rel=" & CStr(L1RelPrev) & "  L2Rel=" & CStr(L2RelPrev))

            varData(0).L0RelPrev = L0RelPrev
            varData(0).L1RelPrev = L1RelPrev
            varData(0).L2RelPrev = L2RelPrev
            Tie.Data = varData(0)
            varData1(0).L0RelPrev = L0RelPrev
            varData1(0).L1RelPrev = L1RelPrev
            varData1(0).L2RelPrev = L2RelPrev
            Tie1.Data = varData1(0)
        End If

        Set Tie = Nothing
        Set Tie1 = Nothing
        Set TSet = Nothing
        Set TSet1 = Nothing
        Set GrCosm = Nothing

End Sub

' Write the Data about CONSTRUCTION CIRCLE into Structure for Graphic and Curve and TCW50olyline

Private Sub FormConCircStruct(GrCirc As Graphic, CurInfo As CosmInfo, LFull As Double)

Dim xi#, yi#, xi1#, yi1#, L#, dL#, sina#, cosa#, Bet#
Dim xc#, yc#, x1#, y1#
    With GrCirc.Vertices
        xc = .Item(0).x
        yc = .Item(0).y
        x1 = .Item(1).x
        y1 = .Item(1).y
    End With
Dim nV As Long, i As Long
    nV = 41
Dim R#, dfi#
    R = Sqr((x1 - xc) * (x1 - xc) + (y1 - yc) * (y1 - yc))
    LFull = 2 * Pi * R
    dfi = 2 * Pi / (nV - 1)

    CurInfo.nV = nV
    L = 0
    CurInfo.lCur(0) = L
    For i = 0 To nV - 2
        xi = xc + R * Cos(dfi * i)
        yi = yc + R * Sin(dfi * i)
        xi1 = xc + R * Cos(dfi * (i + 1))
        yi1 = yc + R * Sin(dfi * (i + 1))
        dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
        sina = (yi1 - yi) / dL
        cosa = (xi1 - xi) / dL
        Bet = Angle(sina, cosa)
        L = L + dL
        CurInfo.xVer(i) = xi
        CurInfo.yVer(i) = yi
        CurInfo.lCur(i + 1) = L
        CurInfo.dL(i) = dL
        CurInfo.Bet(i) = Bet
    Next i
    CurInfo.xVer(nV - 1) = xi1
    CurInfo.yVer(nV - 1) = yi1

End Sub

'#######################################################################
'#######################################################################
'#######################################################################
'#######################################################################

' Write the Data about cosmetic into Structure for Curve and TCW50olyline
Private Sub FormCosmStruct(Gr As Graphic, CurInfo As CosmInfo, LFull As Double)
Dim CurveClosed As Boolean
        If Gr.Closed = True Then
            CurveClosed = True
        Else
            CurveClosed = False
        End If
Dim nV As Long, i As Long, j As Long
        nV = Gr.Vertices.Count
Dim L#, xi#, yi#, xi1#, yi1#, dL#, sina#, cosa#, Bet#
        If CurveClosed = True Then
            CurInfo.nV = nV
            L = 0
            CurInfo.lCur(0) = L
            With Gr.Vertices
                For i = 0 To nV - 2
                    xi = .Item(i).x
                    yi = .Item(i).y
                    xi1 = .Item(i + 1).x
                    yi1 = .Item(i + 1).y
                    dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                    If dL < Eps Then
                        dL = 0
                        Bet = 0
                    Else
                        sina = (yi1 - yi) / dL
                        cosa = (xi1 - xi) / dL
                        Bet = Angle(sina, cosa)
                    End If
                    L = L + dL
                    CurInfo.xVer(i) = xi
                    CurInfo.yVer(i) = yi
                    CurInfo.lCur(i + 1) = L
                    CurInfo.dL(i) = dL
                    CurInfo.Bet(i) = Bet
                Next i
                CurInfo.xVer(nV - 1) = xi1
                CurInfo.yVer(nV - 1) = yi1
            End With
        Else
            CurInfo.nV = nV + 2
Dim k As Long
            k = 0
Dim xPrev#, yPrev#, xLast#, yLast#, LAdd#
            LAdd = 10
            L = 0

            CurInfo.lCur(0) = L
            With Gr.Vertices
                'First added segment
                xi = .Item(0).x
                yi = .Item(0).y
                xi1 = .Item(1).x
                yi1 = .Item(1).y
                dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                If dL < Eps Then
                    For j = 1 To nV - 1
                        xi1 = .Item(j).x
                        yi1 = .Item(j).y
                        dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                        If dL > Eps Then Exit For
                    Next j
                End If
                xPrev = xi1 + (xi - xi1) * (LAdd + dL) / dL
                yPrev = yi1 + (yi - yi1) * (LAdd + dL) / dL
                xi1 = xi
                yi1 = yi
                xi = xPrev
                yi = yPrev
                dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                sina = (yi1 - yi) / dL
                cosa = (xi1 - xi) / dL
                Bet = Angle(sina, cosa)
                L = L + dL
                CurInfo.xVer(k) = xi
                CurInfo.yVer(k) = yi
                CurInfo.lCur(k + 1) = L
                CurInfo.dL(k) = dL
                CurInfo.Bet(k) = Bet
                k = k + 1

                 'Base cosmetic segments
                For i = 0 To nV - 2
                    xi = .Item(i).x
                    yi = .Item(i).y
                    xi1 = .Item(i + 1).x
                    yi1 = .Item(i + 1).y
                    dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                    If dL < Eps Then
                        dL = 0
                        Bet = 0
                    Else
                        sina = (yi1 - yi) / dL
                        cosa = (xi1 - xi) / dL
                        Bet = Angle(sina, cosa)
                    End If
                    L = L + dL
                    CurInfo.xVer(k) = xi
                    CurInfo.yVer(k) = yi
                    CurInfo.lCur(k + 1) = L
                    CurInfo.dL(k) = dL
                    CurInfo.Bet(k) = Bet
                    k = k + 1
                Next i
                'Last added segment
                xi = .Item(nV - 2).x
                yi = .Item(nV - 2).y
                xi1 = .Item(nV - 1).x
                yi1 = .Item(nV - 1).y
                dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                If dL < Eps Then
                    For j = nV - 3 To 0 Step -1
                        xi = .Item(j).x
                        yi = .Item(j).y
                        dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                        If dL > Eps Then Exit For
                    Next j
                End If
                xLast = xi + (xi1 - xi) * (LAdd + dL) / dL
                yLast = yi + (yi1 - yi) * (LAdd + dL) / dL
                xi = xi1
                yi = yi1
                xi1 = xLast
                yi1 = yLast
                dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                sina = (yi1 - yi) / dL
                cosa = (xi1 - xi) / dL
                Bet = Angle(sina, cosa)
                L = L + dL
                CurInfo.xVer(k) = xi
                CurInfo.yVer(k) = yi
                CurInfo.lCur(k + 1) = L
                CurInfo.dL(k) = dL
                CurInfo.Bet(k) = Bet
                k = k + 1
                CurInfo.xVer(k) = xi1
                CurInfo.yVer(k) = yi1
            End With
            ' Edit Content of CurInfo Structure for nonclosed curve
            Call EditCurInfoNonClosed(CurInfo, L)
        End If
        LFull = L

End Sub

' Edit Content of CurInfo Structure for nonclosed curve

Private Sub EditCurInfoNonClosed(CurInfo As CosmInfo, L As Double)
Dim nV As Long, i As Long
Dim LClear#
    LClear = L - 20
    nV = CurInfo.nV
Dim xi#, yi#, xi1#, yi1#
    ' First line segment
    xi = CurInfo.xVer(1)
    yi = CurInfo.yVer(1)
    xi1 = CurInfo.xVer(0)
    yi1 = CurInfo.yVer(0)

    xi1 = xi + (xi1 - xi) * LClear / 10
    yi1 = yi + (yi1 - yi) * LClear / 10
    CurInfo.xVer(0) = xi1
    CurInfo.yVer(0) = yi1
    CurInfo.lCur(1) = LClear
    CurInfo.dL(0) = LClear

    ' Middle segments
Dim dL#, LTem#
    LTem = LClear
    For i = 2 To nV - 2
        dL = CurInfo.dL(i - 1)
        LTem = LTem + dL
        CurInfo.lCur(i) = LTem
    Next i

    ' End line segment
    xi = CurInfo.xVer(nV - 2)
    yi = CurInfo.yVer(nV - 2)
    xi1 = CurInfo.xVer(nV - 1)
    yi1 = CurInfo.yVer(nV - 1)

    xi1 = xi + (xi1 - xi) * LClear / 10
    yi1 = yi + (yi1 - yi) * LClear / 10
    CurInfo.xVer(nV - 1) = xi1
    CurInfo.yVer(nV - 1) = yi1
    CurInfo.lCur(nV - 1) = LTem + LClear
    CurInfo.dL(nV - 2) = LClear

    L = LTem + LClear
End Sub

' define the number of segment by X-Y coordinate of the point
' Return values iMin - Number of segment,
'                Li -Lenght from begining Curve
'                xlocMin - local coordinate on segment

Private Sub NumSegmByXY(CurInfo As CosmInfo, x As Double, y As Double, iMin As Long, Li As Double, xLocMin As Double)
Dim nV As Long, i As Long
Dim xi#, yi#, xi1#, yi1#, Bet#, sina#, cosa#, dL#
Dim xLoc#, yLoc#
Dim yLocMin#

    yLocMin = 1000000
    nV = CurInfo.nV
    For i = 0 To nV - 2
        xi = CurInfo.xVer(i)
        yi = CurInfo.yVer(i)
        xi1 = CurInfo.xVer(i + 1)
        yi1 = CurInfo.yVer(i + 1)
        dL = CurInfo.dL(i)
        Bet = CurInfo.Bet(i)
        sina = Sin(Bet)
        cosa = Cos(Bet)
        yLoc = (y - yi) * cosa - (x - xi) * sina
        xLoc = (y - yi) * sina + (x - xi) * cosa
'MsgBox ("i=" & CStr(i) & "  xi=" & CStr(xi) & " yi=" & CStr(yi) & "  xi1=" & CStr(xi1) & " yi1=" & CStr(yi1) & " dL=" & CStr(dL) & " Bet=" & CStr(Bet * 180 / Pi))
'MsgBox ("xLoc=" & CStr(xLoc) & " yLoc=" & CStr(yLoc))
        If Abs(yLoc) < yLocMin And xLoc > -Eps And xLoc < dL + Eps Then
            yLocMin = Abs(yLoc)
            iMin = i
'            If iMin = 0 Then
'                Li = xLoc
'            Else
                Li = CurInfo.lCur(i) + xLoc
'            End If
            xLocMin = xLoc
        End If
    Next i

End Sub

Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function


Examples - Text Along Curve Tool - frmToolTextAlong.frm

frmToolTextAlong.frm

Text Along Curve Tool Example

VERSION 5.00
Begin VB.Form frmToolTextAlong
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Text Properties"
   ClientHeight    =   4230
   ClientLeft      =   6420
   ClientTop       =   2895
   ClientWidth     =   3930
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4230
   ScaleWidth      =   3930
   Begin VB.TextBox TextOffset
      Height          =   288
      Left            =   240
      TabIndex        =   16
      Text            =   "0.0"
      Top             =   3120
      Width           =   1092
   End
   Begin VB.ComboBox FontText
      Height          =   288
      ItemData        =   "frmToolTextAlong.frx":0000
      Left            =   2160
      List            =   "frmToolTextAlong.frx":008B
      TabIndex        =   14
      Text            =   "Times New Roman"
      Top             =   2400
      Width           =   1212
   End
   Begin VB.ComboBox ModeText
      Height          =   288
      ItemData        =   "frmToolTextAlong.frx":0295
      Left            =   2160
      List            =   "frmToolTextAlong.frx":02A2
      TabIndex        =   12
      Text            =   "Standard"
      Top             =   1680
      Width           =   1212
   End
   Begin VB.ComboBox StyleText
      Height          =   288
      ItemData        =   "frmToolTextAlong.frx":02C4
      Left            =   2160
      List            =   "frmToolTextAlong.frx":02D4
      TabIndex        =   10
      Text            =   "Regular"
      Top             =   960
      Width           =   1212
   End
   Begin VB.CheckBox InvertSym
      Caption         =   "Flip text"
      Height          =   252
      Left            =   2160
      TabIndex        =   9
      Top             =   3120
      Width           =   1332
   End
   Begin VB.TextBox Thick
      Height          =   288
      Left            =   240
      TabIndex        =   7
      Text            =   "0.0"
      Top             =   2400
      Width           =   1092
   End
   Begin VB.TextBox HeightText
      Height          =   288
      Left            =   240
      TabIndex        =   5
      Text            =   "0.4"
      Top             =   1680
      Width           =   1092
   End
   Begin VB.ComboBox Location
      Height          =   288
      ItemData        =   "frmToolTextAlong.frx":02FC
      Left            =   240
      List            =   "frmToolTextAlong.frx":0309
      TabIndex        =   3
      Text            =   "Above"
      Top             =   960
      Width           =   1092
   End
   Begin VB.TextBox MyText
      Height          =   288
      Left            =   240
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   240
      Width           =   3372
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   3600
      Width           =   1092
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   2160
      TabIndex        =   1
      Top             =   3600
      Width           =   1212
   End
   Begin VB.Label Label7
      Caption         =   "Text Offset"
      Height          =   252
      Left            =   360
      TabIndex        =   17
      Top             =   2880
      Width           =   852
   End
   Begin VB.Label Label6
      Caption         =   "Text Font"
      Height          =   252
      Left            =   2400
      TabIndex        =   15
      Top             =   2160
      Width           =   732
   End
   Begin VB.Label Label5
      Caption         =   "Text Mode"
      Height          =   252
      Left            =   2400
      TabIndex        =   13
      Top             =   1440
      Width           =   852
   End
   Begin VB.Label Label4
      Caption         =   "Text Style"
      Height          =   252
      Left            =   2400
      TabIndex        =   11
      Top             =   720
      Width           =   732
   End
   Begin VB.Label Label3
      Caption         =   "Thickness"
      Height          =   252
      Left            =   240
      TabIndex        =   8
      Top             =   2160
      Width           =   1092
   End
   Begin VB.Label Label2
      Caption         =   "Text Height"
      Height          =   252
      Left            =   240
      TabIndex        =   6
      Top             =   1440
      Width           =   852
   End
   Begin VB.Label Label1
      Caption         =   "Text  Location"
      Height          =   252
      Left            =   240
      TabIndex        =   4
      Top             =   720
      Width           =   1092
   End
End
Attribute VB_Name = "frmToolTextAlong"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 1996                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.

' Read-only property indicating cancellation of the
' dialog.
Dim TextStr$, TextH As Variant

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then
        Me.Hide
    End If
    If KeyAscii = 13 Then
        Me.Hide
    End If

End Sub

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    FormCancel = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
Dim TH#
    TH = 0
    TextH = HeightText.Text
    On Error Resume Next
    TH = CDbl(TextH)
    If TH = 0 Then
        MsgBox "Please enter a number in the field 'Text Height'", , "TurboCAD Professional"
        Exit Sub
    End If
    If MyText.Text = "" Or MyText.Text = " " Then
        MsgBox "Text must have one symbol at least", , "TurboCAD Professional"
        Exit Sub
    End If

     FormCancel = False
    Me.Hide
End Sub

Private Sub Form_Load()
    TextStr = MyText.Text
    TextH = HeightText.Text
    FormCancel = True
'Dim i%, iDef%
'    For i = 0 To ScheduleType.ListCount - 1
'        If ScheduleType.List(i) = TypeSchedule Then iDef = i
'    Next i
'    ScheduleType.ListIndex = iDef

End Sub


Examples - Text Along Curve Tool - modToolTextAlong.bas

modToolTextAlong.bas

Text Along Curve Tool Example

Attribute VB_Name = "modToolTextAlong"
Option Explicit
 Type CosmInfo
    nV As Long
    lCur() As Double
    dL() As Double
    xVer() As Double
    yVer() As Double
    Bet() As Double
End Type

Global objApp As XApplication
Global Drs As Drawings
Global ActDr As Drawing
Global Grs As Graphics
Global Vis As Views
Global Vi As View

Global Const Pi = 3.14159265359
Global Const Eps = 0.000001
Global FormCancel As Boolean

Sub Main()
     FormCancel = True
End Sub


Examples - Text Along Curve Tool - clsTextAlong.cls

clsTextAlong.cls

Text Along Curve Tool Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Curve"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Private Declare Function TCWDrawingActive Lib "TCAPI70.dll" () As Long
Private Declare Function TCWGraphicAt Lib "TCAPI70.dll" (ByVal d As Long, ByVal Index As Long) As Long
Private Declare Function TCWVertexAt Lib "TCAPI70.dll" (ByVal g As Long, ByVal Index As Long) As Long

Private Declare Function TCWViewAt Lib "TCAPI70.dll" (ByVal vInd As Long) As Long
Private Declare Function TCWViewCount Lib "TCAPI70.dll" () As Long
Private Declare Function TCWViewActive Lib "TCAPI70.dll" () As Long
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2000                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
'DBAPI constants
Const gkGraphic = 11
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265
Const Eps = 0.000001

'Real variant types!
Const typeEmpty = 0
Const typeInteger = 2
Const typeLong = 3
Const typeSingle = 4
Const typeDouble = 5
Const typeCurrency = 6
Const typeDate = 7
Const typeString = 8
Const typeObject = 9
Const typeBoolean = 11
Const typeVariant = 12
Const typeIntegerEnum = typeInteger + 100
Const typeLongEnum = typeLong + 100
Const typeStringEnum = typeString + 100

'Stock property pages
Const ppStockPen = 1
Const ppStockBrush = 2
Const ppStockText = 4
Const ppStockInsert = 8
Const ppStockViewport = 16
Const ppStockAuto = 32

'Property Ids
Const idMyText = 1
Const idGrConID = 2
Const idTextOffset = 3
Const idTextLocation = 4
Const idGrConIDOld = 5
Const idConVertex = 6
Const idSurvCoord = 7
Const idHeightText = 8
Const idThick = 9
Const idInvertSym = 10
Const idGrConType = 11

Const idStyleText = 12
Const idModeText = 13
Const idFontText = 14

Const idMyTextOld = 15
Const idHeightTextOld = 16

' Properties for changing drawing Units
Const idExplodeScale = 17
Const idUnits = 18
Const idLOld = 19

'Property enums

'Number of properties, pages, wizards
Const NUM_PROPERTIES = 19
Const NUM_PAGES = 1
Const NUM_WIZARDS = 0

Private Sub Class_Initialize()
    'Initialize class variables
End Sub

'Returns the user-visible description of this RegenMethod
Public Property Get Description() As String
    Description = "" ' aalb"SDK_TextAlongCurve"
End Property

'Returns the persistent class id for this RegenMethod's property section
Public Property Get ClassID() As String
    ClassID = "{D25185FF-6A20-11d0-A115-00A024158DAF}"
End Property

'Retrieve types and names
Public Function GetPropertyInfo(Names As Variant, Types As Variant, _
    IDs As Variant, Defaults As Variant) As Long
    ReDim Names(NUM_PROPERTIES), Types(NUM_PROPERTIES), _
        IDs(NUM_PROPERTIES), Defaults(NUM_PROPERTIES)
    Names(0) = "MyText"
    Types(0) = typeString
    IDs(0) = idMyText
    Defaults(0) = "String"

    Names(1) = "GrConID"
    Types(1) = typeLong
    IDs(1) = idGrConID
    Defaults(1) = -1

    Names(2) = "TextOffset"
    Types(2) = typeDouble
    IDs(2) = idTextOffset
    Defaults(2) = 0#

    Names(3) = "TextLocation"
    Types(3) = typeInteger
    IDs(3) = idTextLocation
    Defaults(3) = 0 ' 1 - Above
                    ' 0 - Middle
                    ' -1 - Bottom
    Names(4) = "GrConIDOld"
    Types(4) = typeLong
    IDs(4) = idGrConIDOld
    Defaults(4) = -1

    Names(5) = "ConVertex"
    Types(5) = typeLong
    IDs(5) = idConVertex
    Defaults(5) = -1

    Names(6) = "SurvCoord"
    Types(6) = typeInteger
    IDs(6) = idSurvCoord
    Defaults(6) = 0

    Names(7) = "HeightText"
    Types(7) = typeDouble
    IDs(7) = idHeightText
    Defaults(7) = 0.4

    Names(8) = "Thick"
    Types(8) = typeDouble
    IDs(8) = idThick
    Defaults(8) = 0#

    Names(9) = "InvertSym"
    Types(9) = typeInteger
    IDs(9) = idInvertSym
    Defaults(9) = 0

    Names(10) = "GrConType"
    Types(10) = typeString
    IDs(10) = idGrConType
    Defaults(10) = ""

    Names(11) = "StyleText"
    Types(11) = typeInteger
    IDs(11) = idStyleText
    Defaults(11) = 0

    Names(12) = "ModeText"
    Types(12) = typeInteger
    IDs(12) = idModeText
    Defaults(12) = 1

    Names(13) = "FontText"
    Types(13) = typeString
    IDs(13) = idFontText
    Defaults(13) = "Times New Roman"

    Names(14) = "MyTextOld"
    Types(14) = typeString
    IDs(14) = idMyTextOld
    Defaults(14) = "String"

    Names(15) = "HeightTextOld"
    Types(15) = typeDouble
    IDs(15) = idHeightTextOld
    Defaults(15) = 0.4

' Properties for changing drawing Units
    Names(16) = "ExplodeScale"
    Types(16) = typeDouble
    IDs(16) = idExplodeScale
    Defaults(16) = 1#

    Names(17) = "Units"
    Types(17) = typeString
    IDs(17) = idUnits
    Defaults(17) = ""

    Names(18) = "LOld"
    Types(18) = typeDouble
    IDs(18) = idLOld
    Defaults(18) = 0#

    GetPropertyInfo = NUM_PROPERTIES
End Function

'Get the number of property pages supporting this RegenMethod
Public Function GetPageInfo(ByVal AGraphic As Object, StockPages As Long, _
    Names As Variant) As Long
    ReDim Names(NUM_PAGES)

    'Need the form
    Load frmTextAlong
    Names(0) = frmTextAlong.Caption
    Unload frmTextAlong

    StockPages = ppStockBrush + ppStockPen + ppStockText + ppStockAuto
    GetPageInfo = NUM_PAGES
End Function

Public Function GetWizardInfo(Names As Variant) As Long
    ReDim Names(NUM_WIZARDS)
    GetWizardInfo = NUM_WIZARDS
End Function

'Enumerate the names and values of a specified property
Public Function GetEnumNames(ByVal PropID As Long, Names As Variant, Values As Variant) As Long
    GetEnumNames = 0
End Function

Public Function PageControls(ByVal ThisRegenMethod As Object, ByVal Gr1 As Object, ByVal PageNumber As Long, ByVal SaveProperties As Boolean) As Boolean
        'Set up error function

        On Error GoTo Failed
Dim Gr As Graphic
        Set Gr = Gr1
Dim Sel As Selection
        Set Sel = Gr.Drawing.Selection
Dim SelCount As Long, i As Long
        SelCount = Sel.Count
Dim TextAlongCount As Long
        TextAlongCount = 0
        For i = 0 To SelCount - 1
            If Sel(i).Type = "TextAlong.Curve" Then
                TextAlongCount = TextAlongCount + 1
            End If
        Next i
        Set Sel = Nothing

Dim MyText$
Dim Location%
Dim TextLocation$
Dim SurvCoord%
Dim HeightText#
Dim Thick#
Dim InvertSym%
Dim TextOffset#

Dim StyleText%
Dim ModeText%
Dim FontText$
        If SaveProperties Then
'MsgBox (CStr(frmTextAlong.DialogCanceled))

            'OK button on property page was clicked
            'Form is still loaded
            With frmTextAlong
                'Need On Error statement for the case where you have
                'RRect Turbo Shape and ahother "shape" selected
                On Error Resume Next
                'When the property page is closed, transfer the numeric

                MyText = .MyText.Text
                If MyText <> "" Then
                    Gr.Properties("MyText") = MyText
                End If

                TextLocation = .Location.Text
                If TextLocation <> "" Then
                    Location = -10
                    If TextLocation = "Above" Then Location = 1
                    If TextLocation = "Middle" Then Location = 0
                    If TextLocation = "Bottom" Then Location = -1
                    If Location <> -10 Then
                        Gr.Properties("TextLocation") = Location
                    End If
                End If
'                SurvCoord = .SurvCoord.Value
'                Graphic.Properties("SurvCoord") = SurvCoord

                HeightText = CDbl(.HeightText.Text)
                If .HeightText.Text <> "" Then
                    Gr.Properties("HeightText") = HeightText
                End If

                Thick = CDbl(.Thick.Text)
                If .Thick.Text <> 0 Then
                    Gr.Properties("Thick") = Thick
                End If

                InvertSym = .InvertSym.Value
                If TextAlongCount = 1 Then
                    Gr.Properties("InvertSym") = InvertSym
                End If

                TextOffset = CDbl(.TextOffset.Text)
                If .TextOffset.Text <> "" Then
                    Gr.Properties("TextOffset") = TextOffset
                End If

                If .StyleText.Text = "Regular" Then Gr.Properties("StyleText") = 0
                If .StyleText.Text = "Italic" Then Gr.Properties("StyleText") = 1
                If .StyleText.Text = "Bold" Then Gr.Properties("StyleText") = 2
                If .StyleText.Text = "Bold Italic" Then Gr.Properties("StyleText") = 3

                If .ModeText.Text = "Standard" Then Gr.Properties("ModeText") = 1
                If .ModeText.Text = "Scalable" Then Gr.Properties("ModeText") = 2
                If .ModeText.Text = "Flexible" Then Gr.Properties("ModeText") = 3

                If .FontText.Text <> "" Then
                    Gr.Properties("FontText") = .FontText.Text
                End If
            End With
        Else
            'Property page is about to be opened
            'Make sure the form is loaded
'            Load frmTextAlong
            With frmTextAlong
                On Error GoTo NoRType

                'When the property page is opening, transfer the numeric
                If TextAlongCount = 1 Then ' if was selected single object -TextAlong.Curve
                    MyText = Gr.Properties("MyText")
                    .MyText.Text = MyText

                    Location = Gr.Properties("TextLocation")
                    If Location = 1 Then
                        .Location.Text = "Above"
                    End If
                    If Location = 0 Then
                        .Location.Text = "Middle"
                    End If
                    If Location = -1 Then
                        .Location.Text = "Bottom"
                    End If

                    HeightText = Gr.Properties("HeightText")
                    .HeightText.Text = CStr(HeightText)

                    Thick = Gr.Properties("Thick")
                    .Thick.Text = CStr(Thick)

                    InvertSym = Gr.Properties("InvertSym")
                    .InvertSym.Value = InvertSym

                    TextOffset = Gr.Properties("TextOffset")
                    .TextOffset.Text = CStr(TextOffset)

                    StyleText = Gr.Properties("StyleText")
                    If StyleText = 0 Then .StyleText.Text = "Regular"
                    If StyleText = 1 Then .StyleText.Text = "Italic"
                    If StyleText = 2 Then .StyleText.Text = "Bold"
                    If StyleText = 3 Then .StyleText.Text = "Bold Italic"

                    ModeText = Gr.Properties("ModeText")
                    If ModeText = 1 Then .ModeText.Text = "Standard"
                    If ModeText = 2 Then .ModeText.Text = "Scalable"
                    If ModeText = 3 Then .ModeText.Text = "Flexible"

                    FontText = Gr.Properties("FontText")
                    .FontText.Text = FontText
                Else
                    .MyText.Text = ""
                    .Location.Text = ""
                    .HeightText.Text = ""
                    .Thick.Text = ""
                    .InvertSym.Value = 0
                    .TextOffset.Text = ""
                    .StyleText.Text = ""
                    .ModeText.Text = ""
                    .FontText.Text = ""
                End If
NoRType:
            End With
        End If

        Set Gr = Nothing
        PageControls = True
        Exit Function

Failed:
        'For debugging purposes, report that an error occurred
        If Err.Number <> 0 Then
            MsgBox "Error in PageControls: " & Err.Description
        End If

        'Return false if an error occurred
        PageControls = False
End Function

Public Function PageDone(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant)
        'Done with form
        Unload frmTextAlong
End Function

Public Function PropertyPages(ByVal ThisRegenMethod As Object, Optional PageNumber As Variant) As Boolean
   With frmTextAlong
        .Show vbModal
        PropertyPages = Not .DialogCanceled
    End With
End Function

Public Function Wizard(ByVal ThisRegenMethod As Object, Optional WizardNumber As Variant) As Boolean
    Wizard = False
End Function

'Called when vertex has been moved, or other geometry change
Public Function OnGeometryChanged(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant)
    'Do nothing
    'Regen Graphic
End Function

'Called when vertex is moved, or other geometry change
Public Function OnGeometryChanging(ByVal Graphic As Object, ByVal GeomID As Long, paramOld As Variant, paramNew As Variant) As Boolean
    'OK to continue with change
    OnGeometryChanging = True
End Function

Public Function OnNewGraphic(ByVal grfThis As Object, ByVal boolCopy As Boolean) As Boolean
    If boolCopy Then
        'Vertices are already added for us...
        OnNewGraphic = True
        Exit Function
    End If
Dim Gr As Graphic
    Set Gr = grfThis

    On Error GoTo Failed

    'New Graphic being created
    'X, Y, Z, PenDown, Selectable, Snappable, Editable, Linkable
    With Gr.Vertices
        .Add -1000, 0, 0, False
        .Add -1001, 0, 0, False
        .Add -999, 0, 0, False
    End With
    Gr.Properties("LimitVertices") = 3
    OnNewGraphic = True
    Exit Function

Failed:
    'Return false on failure
    OnNewGraphic = False
End Function

'Function called whenever a copy of a graphic is being made
Public Function OnCopyGraphic(ByVal grfCopy As Object, ByVal grfSource As Object) As Boolean
    'Return false on failure
    OnCopyGraphic = True
End Function

'Notification function called after graphic property is saved
Public Function OnPropertyChanged(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant)
    'Do nothing
End Function

'Notification function called when graphic property is saved
Public Function OnPropertyChanging(ByVal Graphic As Object, ByVal PropID As Long, _
        ValueOld As Variant, ValueNew As Variant) As Boolean
    'OK to proceed
    OnPropertyChanging = True
End Function

'Notification function called when graphic property is retrieved
Public Function OnPropertyGet(ByVal Graphic As Object, ByVal PropID As Long)
    'Do nothing
End Function

'Called when we need to update our object
Public Function Regen(ByVal grfThis As Object)
'MsgBox ("Regen")
        'Setup error handler
        On Error GoTo Failed
Dim Gr As Graphic
Dim GrProps As Properties
Dim Gr1 As Graphic
Dim GrCon As Graphic
    Set Gr = grfThis

    ' Define if Units were changed
    Call ChangingUnits(Gr)
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' if exist parent graphic then exit from regen
Dim ParentExist As Boolean
    ParentExist = False
Dim GrPar As Variant
    Set GrPar = Nothing
    On Error Resume Next
    Set GrPar = Gr.Parent
    If GrPar Is Nothing Then
        ParentExist = True  ' If Parent is BlockInsertion
        Set GrPar = Nothing
    Else
        If GrPar.Type <> "GRAPHIC" Then
            ParentExist = False ' If Parent is Root
        Else
            ParentExist = True  ' if Parent is Group or Symbol
        End If
        Set GrPar = Nothing
    End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Define Root - Grs-collection for current graphic
'Dim Grs1 As Graphics
'Dim GrID As Long
'            GrID = Gr.ID
'Dim GrModalRoot As Graphic 'GraphicsCollection of Modal Space
'Dim DrEx As DwgEx  'Albul's server
'            Set DrEx = New DwgEx
'            Set GrModalRoot = DrEx.GetModelSpaceRootGraphic(Gr.Drawing)
'            Set Grs1 = GrModalRoot.Graphics
'Dim Space%
'            Set Gr1 = Nothing
'            On Error Resume Next
'            Set Gr1 = Grs1.GraphicFromID(GrID)
'            If Gr1 Is Nothing Then
'MsgBox ("Paper")
'                Set Grs1 = Nothing
'                Set Grs1 = Gr.Drawing.Graphics
'            Else
'MsgBox ("Modal")
'                If Gr1.Type <> "TextAlong.Curve" Then
'                    Set Grs1 = Nothing
'                    Set Grs1 = Gr.Drawing.Graphics
'                End If
'            End If
'            Set Grs1 = GrModalRoot.Graphics
'MsgBox (Grs1.Count)
'            Set GrModalRoot = Nothing
'            Set DrEx = Nothing
 '           Set Grs1 = Gr.Drawing.Graphics

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

    Set GrProps = Gr.Properties
        'Set up lock (prevent recursion)
Dim LockCount&
    LockCount& = grfThis.RegenLock

        'Setup error handler (make sure lock is removed)
On Error GoTo FailedLock
'###################################################################
    If LockCount& = 0 Then
Dim NewGraphic As Boolean
        NewGraphic = False
        If Gr.Graphics.Count < 2 Then
            NewGraphic = True
        Else
            NewGraphic = False
            ' Delete all Cosmetic
Dim NumCosm As Long, j As Long
Dim Col As Long
Dim CosmCurveExist As Boolean
            CosmCurveExist = False
            Col = Gr.Application.Properties("PaperColor")
            NumCosm = Gr.Graphics.Count
            With Gr.Graphics
                On Error Resume Next
                For j = 0 To NumCosm - 1
                    If .Item(j).Type = "TCW30CURVE" Then
                        CosmCurveExist = True
'                        On Error Resume Next
                        .Item(j).Cosmetic = False
                    End If
                    If .Item(j).Cosmetic = True Then
                        .Item(j).Properties("PenColor") = Col
'                        .Item(j).Properties("BrushColor") = Col
                        .Item(j).Draw
                    End If
                Next j
            End With
            Gr.Graphics.Clear gfCosmetic
        End If
Dim x0#, y0#, x1#, y1#, x2#, y2#
        With Gr.Vertices
            x0 = .Item(0).x
            y0 = .Item(0).y
            x1 = .Item(1).x
            y1 = .Item(1).y
            x2 = .Item(2).x
            y2 = .Item(2).y
        End With

Dim GrConID As Long
        GrConID = GrProps("GrConID")
Dim GrConIDOld As Long
        GrConIDOld = GrProps("GrConIDOld")
Dim GrConType$
        GrConType = GrProps("GrConType")

'MsgBox ("GrConType=" & GrConType & " GrConID=" & CStr(GrConID) & " GrConIDOld=" & CStr(GrConIDOld) & " GrTextID=" & CStr(Gr.ID))
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' Define if exist connection this graphic - TextAlongCurve
' with connected Curve. This needed for RubberStamp and Copy/Paste
Dim DeleteConnection As Boolean
        DeleteConnection = False
        If GrConID <> -1 And GrConIDOld <> -1 And ParentExist = False Then
Dim TieWasted As Boolean
            TieWasted = False
            GrConID = ConnectionExist(Gr, GrConID, TieWasted)
            If GrConID = -1 Then
                DeleteConnection = True
'MsgBox ("1111")
'                GrProps("GrConID") = -1
'                GrConID = -1
'                GrConIDOld = -1
                GrConID = -1
                GrConIDOld = -1
                GrConType = ""
            End If
        End If
'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        If Gr.ID = 0 Then
 '           GrProps("GrConID") = -1
 '           GrProps("GrConIDOld") = -1
 '           GrProps("GrConType") = ""
            GrConID = -1
            GrConIDOld = -1
            GrConType = ""
        End If

        If GrConID <> -1 And GrConIDOld <> -1 Then
            Set GrCon = Nothing
            On Error Resume Next
            Set GrCon = Gr.Drawing.Graphics.GraphicFromID(GrConID)
'            Set GrCon = Grs1.GraphicFromID(GrConID)
            If GrCon Is Nothing Then
                '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
                ' if connected was deleted or changed its ID dedine connection to new graphic
                ' if it concident with 0-Vertices of TextAlong-graphic
                ' function return ID new connected curve or -1
'                GrProps("GrConID") = -1
'                GrProps("GrConIDOld") = -1
'                GrProps("GrConType") = ""
                GrConID = -1
                GrConIDOld = -1
                '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
            End If
        End If
        '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
        ' Snap to Nearest Graphic
        ' if connected was deleted or changed its ID dedine connection to new graphic
        ' if it concident with 0-Vertices of TextAlong-graphic
        ' function return ID new connected curve or -1
        If NewGraphic = False And GrConID = -1 And GrConIDOld = -1 And Gr.ID <> 0 Then
'MsgBox ("SNAP")
'            GrConID = SnapToNearestGraphic(Gr) ' ??????????????????
'MsgBox ("GrConId=" & CStr(GrConID))
            If GrConID = -1 Then
'                GrProps("GrConID") = -1
'                GrProps("GrConIDOld") = -1
'                GrProps("GrConType") = ""
                GrConType = ""
            Else
                GrConType = GrProps("GrConType")
                GrConIDOld = GrConID
            End If
        End If
        '$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$

Dim MyText$
        MyText = GrProps("MyText")
Dim SurvCoord%
        SurvCoord = GrProps("SurvCoord")
Dim hText#
        hText = GrProps("HeightText")
Dim Thick#
        Thick = GrProps("Thick")
Dim TextOffset#
        TextOffset = GrProps("TextOffset")

Dim StyleText%
        StyleText = GrProps("StyleText")
Dim ModeText%
        ModeText = GrProps("ModeText")
Dim FontText$
        FontText = GrProps("FontText")

' Add Symbols from string as Cosmetic
Dim StrLen As Long, i As Long
        StrLen = VBA.Len(MyText)
Dim Sym() As TextSym
ReDim Sym(StrLen)
Dim Char$
Dim GrText As Graphic
Dim GrSets As GraphicSets
Dim GrSet As GraphicSet
        Set GrSets = Gr.Drawing.GraphicSets
        Set GrSet = GrSets.Add

Dim xMax#, yMax#, xMin#, yMin#, LText#
        LText = 0
        For i = 1 To StrLen
            Char = VBA.Mid(MyText, i, 1)
            Sym(i - 1).Char = Char
            Set GrText = Gr.Graphics.AddText(Char, 0, 0, 0, hText)
Dim GrTextProps As Properties
            Set GrTextProps = GrText.Properties
            GrTextProps("TextStyle") = StyleText
            GrTextProps("TextMode") = ModeText
            GrTextProps("TextFont") = FontText
            On Error Resume Next
            GrTextProps("Thickness") = Thick
            GrTextProps("PenColor") = GrProps("PenColor")
            GrText.Cosmetic = True
            GrSet.AddGraphic GrText
            With GrText.CalcBoundingBox
                xMax = .Max.x
                yMax = .Max.y
                xMin = .Min.x
                yMin = .Min.y
            End With
            Sym(i - 1).H = yMax - yMin
            Sym(i - 1).W = xMax - xMin
            LText = LText + Sym(i - 1).W
            Sym(i - 1).xMin = xMin
            Sym(i - 1).yMin = yMin
            Sym(i - 1).xc = (xMax + xMin) / 2
            Sym(i - 1).yc = (yMax + yMin) / 2
            Set GrTextProps = Nothing
        Next i
        LText = 1.3 * LText
'MsgBox ("lText=" & CStr(LText))
'######################################################################
        ' begin if new graphic
Dim GrCent As Graphic
Dim xMid#, yMid#
        If NewGraphic = True Then
            With Gr.Vertices
                .Item(1).x = x0 - LText / 2
                .Item(1).y = y0 - hText / 2
                .Item(2).x = x0 + LText / 2
                .Item(2).y = y0 - hText / 2
            End With
            ' Add CenterPoint Graphic
            Set GrCent = Gr.Graphics.Add(11)
            On Error Resume Next
            GrCent.Properties("Thickness") = 0

            With GrCent.Vertices
                .Add x0, y0, 0, False, False, False, False, False
                .Add x0 - LText / 2, y0 - hText / 2, 0, False, False, False, False, False
                .Add x0 + LText / 2, y0 - hText / 2, 0, False, False, False, False, False
            End With
            xMid = x0 - LText / 2 + Sym(0).W / 2
            yMid = y0
            For i = 0 To StrLen - 1
                Set GrText = GrSet(i)
                GrText.MoveRelative xMid - Sym(i).xc, yMid - Sym(i).yc, 0
                If i <> StrLen - 1 Then
                    xMid = xMid + Sym(i).W / 2 + Sym(i + 1).W / 2
                End If
            Next i
        End If
        ' end if new graphic
'######################################################################
'MsgBox ("NewGraphic=" & CStr(NewGraphic) & "  GrConID=" & CStr(GrConID) & "  CosmCurveExist=" & CStr(CosmCurveExist))
'MsgBox ("CosmCurveExist=" & CStr(CosmCurveExist))
'MsgBox ("GrConType=" & GrConType & " GrConID=" & CStr(GrConID) & " GrConIDOld=" & CStr(GrConIDOld) & " GrTextID=" & CStr(Gr.ID))
'MsgBox ("CosmCurveExist=" & CStr(CosmCurveExist))
        If GrConID = -1 And NewGraphic = False Then
'MsgBox ("1111")
            If CosmCurveExist = False Then
                Call LineText(Gr, GrSet, Sym, StrLen, hText)
            Else
                Call TextAlongCoismeticCurve(Gr, GrSet, Sym, StrLen, hText)
            End If
        End If
        ' if graphic was modify
        If GrConID <> -1 And NewGraphic = False Then
'MsgBox ("2222" & "  ParentExist=" & CStr(ParentExist))
            Set GrCon = Nothing
            On Error Resume Next
            Set GrCon = Gr.Drawing.Graphics.GraphicFromID(GrConID)
'            Set GrCon = Grs1.GraphicFromID(GrConID)
            If GrCon Is Nothing Then
                If CosmCurveExist = False Then
                    Call LineText(Gr, GrSet, Sym, StrLen, hText)
                Else
                    Call TextAlongCoismeticCurve(Gr, GrSet, Sym, StrLen, hText)
                End If
                GoTo LEND
            Else
Dim ChWithWidth As Boolean
                ChWithWidth = False
'MsgBox ("Regen   " & GrCon.Type)
                If GrCon.Type = "TCW50Polyline" Then
'                    If GrCon.Graphics.Count > 1 Then
'                        ChWithWidth = True
'                    End If
                    If GrCon.Graphics.Count > 0 Then
'MsgBox ("Regen   " & GrCon.Type & "   " & CStr(GrCon.Graphics.Count) & "  " & GrCon.Graphics(0).Name)
                        If GrCon.Graphics(0).Name = "Line_Width_Cosmetic" Or GrCon.Graphics(0).Name = "ChildWithWidths" Then
                            ChWithWidth = True
                        End If
                    End If
                End If
            End If
            If GrConType = "GRAPHIC" Or GrConType = "CIRCLE" Or GrConType = "ARC" Or GrConType = "TCW30CURVE" Or GrConType = "TCW50Polyline" Then
                If ChWithWidth = True Or TieWasted = True Then
' MsgBox ("Regen    " & CStr(ChWithWidth))
                   Call TextAlongCoismeticCurve(Gr, GrSet, Sym, StrLen, hText)
                Else
                    If ParentExist = False Then
                        Call TextAlongCurve(Gr, GrCon, GrSet, Sym, StrLen, hText) ', Grs1)
                    Else
                        Call TextAlongCoismeticCurve(Gr, GrSet, Sym, StrLen, hText)
                    End If
                End If
            End If
        End If
LEND:
        If DeleteConnection = True Then
            GrProps("GrConID") = -1
            GrProps("GrConType") = ""
        End If
        GrProps("GrConIDOld") = GrProps("GrConID")
        GrProps("MyTextOld") = MyText
        GrProps("HeightTextOld") = GrProps("HeightText")
        GrSet.Clear
        Set GrSet = Nothing
        Set GrSets = Nothing
        Set GrProps = Nothing
        Set GrCon = Nothing
        Set GrCent = Nothing
        Set Gr1 = Nothing
    End If
'###################################################################

    Gr.RegenUnlock
    Set Gr = Nothing
'    Set Grs1 = Nothing

    Exit Function

FailedLock:
        'Remove lock

'        Set Grs = Nothing
Failed:
        grfThis.RegenUnlock
        If Err.Number <> 0 Then
'            MsgBox "Regen error: " & Err.Description
        End If
End Function

Public Function Draw(ByVal grfThis As Object, ByVal view As Object, Optional mat As Variant) As Boolean
    'Return True if we did the redraw (no further processing necessary, no children will be drawn).
    'Since this is just a test, we return False to let TurboCAD do the drawing operation.
Dim Gr As Graphic
    Set Gr = grfThis
Dim GrCount As Long, i As Long
Dim Col As Long
    Col = Gr.Application.Properties("PaperColor")
    GrCount = Gr.Graphics.Count
    With Gr.Graphics
        For i = 0 To GrCount - 1
            If .Item(i).Type = "GRAPHIC" Then
                .Item(i).Properties("PenColor") = Col
                .Item(i).Properties("BrushColor") = Col
'                .Item(i).Draw
            End If
        Next i
    End With
    Draw = False
End Function

Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function

Private Sub LineText(Gr As Graphic, GrSet As GraphicSet, Sym() As TextSym, StrLen As Long, hText As Double)
'MsgBox ("TextAlongLine")
' Begin Define the old center graphic
Dim GrCent As Graphic
Dim GrCount As Long, i As Long
        GrCount = Gr.Graphics.Count
        For i = 0 To GrCount - 1
            Set GrCent = Gr.Graphics(i)
            If GrCent.Type = "GRAPHIC" And GrCent.Cosmetic = False Then
                If GrCent.Vertices.Count = 3 Then
                    Exit For
                End If
            End If
        Next i
Dim xCentOld#, yCentOld#
        With GrCent.Vertices
            xCentOld = .Item(0).x
            yCentOld = .Item(0).y
        End With
' End Define the old center graphic

Dim GrText As Graphic
Dim x0#, y0#, x1#, y1#, x2#, y2#
        With Gr.Vertices
            x0 = .Item(0).x
            y0 = .Item(0).y
            x1 = .Item(1).x
            y1 = .Item(1).y
            x2 = .Item(2).x
            y2 = .Item(2).y
        End With
        ' Define if was moved the center vertex of the text
Dim CentMoved As Boolean
        If Abs(xCentOld - x0) < Eps And Abs(yCentOld - y0) < Eps Then
            CentMoved = False
        Else
            CentMoved = True
        End If
Dim L#, sina#, cosa#, x0Loc#, y0Loc#
Dim Alpha#
Dim dxCent#, dyCent#
        L = Sqr((x2 - x1) * (x2 - x1) + (y2 - y1) * (y2 - y1))
        sina = (y2 - y1) / L
        cosa = (x2 - x1) / L
        Alpha = Angle(sina, cosa)
        If CentMoved = False Then
            x0Loc = L / 2
            y0Loc = 0
            x0 = x1 + x0Loc * cosa - y0Loc * sina
            y0 = y1 + x0Loc * sina + y0Loc * cosa
            With Gr.Vertices
                .Item(0).x = x0
                .Item(0).y = y0
            End With
        Else
            dxCent = x0 - xCentOld
            dyCent = y0 - yCentOld
            x1 = x1 + dxCent
            y1 = y1 + dyCent
            x2 = x2 + dxCent
            y2 = y2 + dyCent
            With Gr.Vertices
                .Item(1).x = x1
                .Item(1).y = y1
                .Item(2).x = x2
                .Item(2).y = y2
            End With
        End If
        ' correct location of the center child graphic
        With GrCent.Vertices
            .Item(0).x = x0
            .Item(0).y = y0
            .Item(1).x = x1
            .Item(1).y = y1
            .Item(2).x = x2
            .Item(2).y = y2
        End With
' locate text between 2 limits vertices
Dim xLocSym() As Double
ReDim xLocSym(StrLen)
Dim yLocSym As Double
Dim L1#, dL#
Dim xci#, yci#
        yLocSym = 0
        xLocSym(0) = Sym(0).W / 2
        xLocSym(StrLen - 1) = L - Sym(StrLen - 1).W / 2
        L1 = xLocSym(StrLen - 1) - xLocSym(0)
        dL = L1 / (StrLen - 1)
        For i = 1 To StrLen - 2
            xLocSym(i) = xLocSym(i - 1) + dL
        Next i
        For i = 0 To StrLen - 1
            Set GrText = GrSet(i)
            GrText.RotateAxis Alpha, 0, 0, 1, Sym(i).xc, Sym(i).yc, 0

            xci = x1 + xLocSym(i) * cosa - yLocSym * sina
            yci = y1 + xLocSym(i) * sina + yLocSym * cosa
            GrText.MoveRelative xci - Sym(i).xc, yci - Sym(i).yc, 0
        Next i

        Set GrCent = Nothing
        Set GrText = Nothing

End Sub

'##########################################################################
'##########################################################################
'##########################################################################
'##########################################################################
'##########################################################################
' Draw Text along curve
Private Sub TextAlongCurve(Gr As Graphic, GrCurve As Graphic, GrSet As GraphicSet, Sym() As TextSym, StrLen As Long, hText As Double) ', Grs1 As Graphics)
'MsgBox ("TextAlongCurve")
'Dim SurvCoord%
'        SurvCoord = Gr.Properties("SurvCoord")
Dim GrProps As Properties
    Set GrProps = Gr.Properties
Dim MyText$, MyTextOld$
Dim HeightText#, HeightTextOld#
    MyText = GrProps("MyText")
    MyTextOld = GrProps("MyTextOld")
    HeightText = GrProps("HeightText")
    HeightTextOld = GrProps("HeightTextOld")
Dim TextChanged As Boolean
    TextChanged = False
    If MyText <> MyTextOld Or HeightText <> HeightTextOld Then
        TextChanged = True
    End If

Dim TextLocation%
    TextLocation = GrProps("TextLocation")
Dim TextOffset#
    TextOffset = GrProps("TextOffset")
Dim GrConIDOld As Long
    GrConIDOld = GrProps("GrConIDOld")
Dim GrConType$
    GrConType = GrProps("GrConType")
    If GrConType = "TCW50Polyline" And GrCurve.Graphics.Count = 0 Then
        GrConType = "GRAPHIC"
    End If
Dim GrCent As Graphic
Dim GrCount As Long, i As Long
        ' Delete Base Graphic Curve
EEE:
        GrCount = Gr.Graphics.Count
        For i = 0 To GrCount - 1
            Set GrCent = Gr.Graphics(i)
            If GrCent.Type = "TCW30CURVE" Then
                GrCent.Deleted = True
                GoTo EEE
            End If
        Next i

'Define the old Center graphic
        GrCount = Gr.Graphics.Count
        For i = 0 To GrCount - 1
            Set GrCent = Gr.Graphics(i)
            If GrCent.Type = "GRAPHIC" And GrCent.Cosmetic = False Then
                If GrCent.Vertices.Count = 3 Then
                    Exit For
                End If
            End If
        Next i
Dim xCentOld#, yCentOld#, x1Old#, y1Old#, x2Old#, y2Old#
        With GrCent.Vertices
            xCentOld = .Item(0).x
            yCentOld = .Item(0).y
            x1Old = .Item(1).x
            y1Old = .Item(1).y
            x2Old = .Item(2).x
            y2Old = .Item(2).y
        End With
Dim CurveClosed As Boolean
        If GrCurve.Closed = True Then
            CurveClosed = True
        Else
            CurveClosed = False
        End If
'MsgBox ("CurveClosed=" & CStr(CurveClosed))

Dim GrCosm As Graphic
        If GrConType = "TCW30CURVE" Then
            Set GrCosm = GrCurve.Graphics(1)
        End If
        If GrConType = "TCW50Polyline" Then
            Set GrCosm = GrCurve.Graphics(0)
        End If
        If (GrConType = "CIRCLE" And GrCurve.Unbounded = False) Or GrConType = "ARC" Then
Dim x0#, y0#, x1#, y1#, x2#, y2#, x3#, y3#
            With GrCurve.Vertices
                x0 = .Item(0).x
                y0 = .Item(0).y
                x1 = .Item(1).x
                y1 = .Item(1).y
                x2 = .Item(2).x
                y2 = .Item(2).y
                x3 = .Item(3).x
                y3 = .Item(3).y
            End With
Dim GrTem As Graphic
            Set GrTem = Gr.Drawing.Graphics.Add(imsiGroup)
            Set GrCosm = GrTem.Graphics.AddCircleCenterAndPoint(0, 0, 0, 0, 1, 0)
            If Gr.Drawing.Properties("TileMode") = 1 Then
                GrCosm.Properties("Thickness") = 0
                GrCosm.Properties("BrushStyle") = ""
                GrCosm.Update
            End If
'MsgBox ("111")
            With GrCosm.Vertices
                .Item(0).x = x0
                .Item(0).y = y0
                .Item(1).x = x1
                .Item(1).y = y1
                .Item(2).x = x2
                .Item(2).y = y2
                .Item(3).x = x3
                .Item(3).y = y3
            End With
            If GrConType = "CIRCLE" Then
                GrCosm.Closed = True
            Else
                GrCosm.Closed = False
            End If

'            Set GrCosm = GrCurve.Duplicate
'            If Gr.Drawing.Properties("TileMode") = 1 Then
'                On Error Resume Next
'                If GrCosm.Properties("Thickness") <> 0 Then
'                    GrCosm.Properties("Thickness") = 0
'                    GrCosm.Update
'                End If
'            End If
'            GrCosm.Properties("BrushStyle") = ""
'            GrCosm.Update
'            Gr.Drawing.Graphics.Remove GrCosm.Index
            GrTem.Graphics.Remove GrCosm.Index
            Set GrCosm = GrCosm.Explode(0)
        End If

Dim nV As Long
        If GrCurve.Unbounded = True And GrConType = "CIRCLE" Then
            nV = 50
        Else
            If GrConType = "GRAPHIC" Then
                nV = GrCurve.Vertices.Count
            Else
                nV = GrCosm.Vertices.Count
            End If
        End If

Dim xi#, yi#, xi1#, yi1#, dL#, L#, Bet#
Dim sina#, cosa#
Dim CurInfo As CosmInfo
ReDim CurInfo.dL(nV + 5)
ReDim CurInfo.lCur(nV + 5)
ReDim CurInfo.xVer(nV + 5)
ReDim CurInfo.yVer(nV + 5)
ReDim CurInfo.Bet(nV + 5)
Dim LFull#
        If GrCurve.Unbounded = True And GrConType = "CIRCLE" Then
            Call FormConCircStruct(GrCurve, CurInfo, LFull)
        Else
            If GrConType = "GRAPHIC" Then
                Call FormCosmStruct(GrCurve, CurInfo, LFull, 1)
            Else
                Call FormCosmStruct(GrCosm, CurInfo, LFull, 1)
            End If
            If GrConType = "CIRCLE" Or GrConType = "ARC" Then
                GrCosm.Deleted = True
                GrTem.Deleted = True
                Set GrTem = Nothing
            End If
        End If

'MsgBox ("LFull=" & CStr(LFull))
' Define the Parameters of the text
        With Gr.Vertices
            x0 = .Item(0).x
            y0 = .Item(0).y
            x1 = .Item(1).x
            y1 = .Item(1).y
            x2 = .Item(2).x
            y2 = .Item(2).y
            .Item(2).Editable = False
        End With

Dim LText0#, LText#, L0#, L1#, L2#, L0Old#
        LText0 = 0
        For i = 0 To StrLen - 1
            LText0 = LText0 + Sym(i).W
        Next i
'        iSeg0 = NumSegmByXY(CurInfo, x0, y0, iSeg0,l0, xLoc0)
        'if First location text on curve
        ' text located at middle of Curve
        If GrConIDOld = -1 Then
            L0 = LFull / 2.01
            L1 = L0 - LText0 / 2
            L2 = L0 + LText0 / 2
        End If

        ' Define if was moved the center vertex of the text
Dim CentMoved As Boolean
        If Abs(xCentOld - x0) < Eps And Abs(yCentOld - y0) < Eps Then
            CentMoved = False
        Else
            CentMoved = True
        End If
Dim AllMoved As Boolean
        If CentMoved = False And (Abs(x1Old - x1) < Eps And Abs(y1Old - y1) < Eps) And (Abs(x2Old - x2) < Eps And Abs(y2Old - y2) < Eps) Then
            AllMoved = True
        Else
            AllMoved = False
        End If

Dim iSeg0 As Long, xLoc0#
Dim iSeg1 As Long, xLoc1#
Dim iSeg2 As Long, xLoc2#
Dim iSeg0Old As Long, xLoc0Old#

        ' if was moved center vertex of the text
        If CentMoved = True And GrConIDOld <> -1 Then
'MsgBox ("CenterMoved")
            Call NumSegmByXY(CurInfo, x1, y1, iSeg1, L1, xLoc1)
            Call NumSegmByXY(CurInfo, x2, y2, iSeg2, L2, xLoc2)
            LText = L2 - L1
'MsgBox (" New L1=" & CStr(L1) & "  L2=" & CStr(L2))
Dim L1Old#, L2Old#
            If CurveClosed = True Then
                Call NumSegmByXY(CurInfo, xCentOld, yCentOld, iSeg0Old, L0Old, xLoc0Old)
                Call NumSegmByXY(CurInfo, x1Old, y1Old, iSeg1, L1Old, xLoc1)
                Call NumSegmByXY(CurInfo, x2Old, y2Old, iSeg2, L2Old, xLoc2)
'MsgBox (" Old L1=" & CStr(L1Old) & "  L2=" & CStr(L2Old))
                Call LenghtOfText(LFull, L0Old, L1Old, L2Old, LText)
'MsgBox ("LText=" & CStr(LText))
            End If
            Call NumSegmByXY(CurInfo, x0, y0, iSeg0, L0, xLoc0)
            L1 = L0 - LText / 2
            L2 = L0 + LText / 2
        End If

        ' if was moved one of the bounded vertices of the text
        If CentMoved = False And GrConIDOld <> -1 Then
'MsgBox ("CenterNotMoved")
            Call NumSegmByXY(CurInfo, x0, y0, iSeg0, L0, xLoc0)
'MsgBox ("x0=" & CStr(x0) & "  y0=" & CStr(y0) & " L0=" & CStr(L0) & "  Lfull=" & CStr(LFull))
            Call NumSegmByXY(CurInfo, x1, y1, iSeg1, L1, xLoc1)
            Call NumSegmByXY(CurInfo, x2, y2, iSeg2, L2, xLoc2)
'            LText = L2 - L1
            LText = (L0 - L1) * 2
Dim LTextSign%
            If Abs(LText) < LText0 Then
                LTextSign = Sign(LText)
                If LTextSign = 0 Then LTextSign = 1
                LText = LTextSign * LText0
                L1 = L0 - LText / 2
            End If
            L2 = L0 + LText / 2
            If CurveClosed = True And Abs(LText) / 2 > Abs(LFull) / 2 Then
                If L0 > L1 Then
                    L2 = L0 - (LFull - L0) - L1
                End If
                 If L0 < L1 Then
                    L2 = L0 + L0 + (LFull - L1)
                End If
                Call LenghtOfText(LFull, L0, L1, L2, LText)
'                If LText < LText0 Then
'                    LTextSign = Sign(LText)
'                    If LTextSign = 0 Then LTextSign = 1
'                    LText = LTextSign * LText0
'                End If
                L1 = L0 - LText / 2
                L2 = L0 + LText / 2
            End If
            ' if was changed property "MyText" Or "TextHeight"
            If TextChanged = True Then
                L1 = L0 - LText0 / 2
                L2 = L0 + LText0 / 2
            End If

        End If

'MsgBox ("LText=" & CStr(LText) & "  L0=" & CStr(L0) & " L1=" & CStr(L1) & " L2=" & CStr(L2))
Dim LTem#
Dim iSegi As Long, xLoci#, yLoci#
        ' define Coordinate xi,yi from Li
        Call XYFromL(CurInfo, LFull, L0, x0, y0)
        Call XYFromL(CurInfo, LFull, L1, x1, y1)
        Call XYFromL(CurInfo, LFull, L2, x2, y2)

        ' Assign new location for base vertices of text
        With Gr.Vertices
            .Item(0).x = x0
            .Item(0).y = y0
            .Item(1).x = x1
            .Item(1).y = y1
            .Item(2).x = x2
            .Item(2).y = y2
        End With

        If StrLen > 1 Then
            dL = (L2 - L1) / (StrLen - 1)
        End If
        If StrLen = 1 Then ' if String=single symbol
            dL = (L2 - L1) / 2
        End If
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Define real Height of Symbol
Dim hTextNew#, ycNew#, dycNew#
        Call SymRealHeight(Gr, hText, hTextNew, ycNew, dycNew)
        For i = 0 To StrLen - 1
            Sym(i).yc = ycNew - dycNew / 2
        Next i
        hText = 1.2 * hTextNew
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
Dim SymMidWid#
        If StrLen > 1 Then
            SymMidWid = LText0 / (StrLen - 1)
        Else
            SymMidWid = LText0
        End If

' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

Dim InvertSym%
        InvertSym = Gr.Properties("InvertSym")
Dim j As Long
        For i = 0 To StrLen - 1
            If StrLen > 1 Then
                L = L1 + i * dL
            End If
            If StrLen = 1 Then  ' if String=single symbol
                L = L1 + (i + 1) * dL
            End If

            LTem = L
            If L > LFull Then LTem = L - LFull
            If L < 0 Then LTem = LFull + L
Dim xText#, yText#
Dim GrText As Graphic
            Call NumSegmByL(CurInfo, LTem, iSegi, xLoci)
'MsgBox ("i=" & CStr(i) & " l=" & CStr(L) & " isegi=" & CStr(iSegi))
            Bet = CurInfo.Bet(iSegi)
            xi = CurInfo.xVer(iSegi)
            yi = CurInfo.yVer(iSegi)
            ' if location = Middle
            yLoci = TextLocation * hText / 2 + TextOffset

            xText = xi + xLoci * Cos(Bet) - yLoci * Sin(Bet)
            yText = yi + xLoci * Sin(Bet) + yLoci * Cos(Bet)
           If i = 0 Then
' Add BaseCosmetic Graphic -Curve
Dim CosmCurve As Graphic
                Set CosmCurve = Gr.Graphics.AddCurveBezier(xText, yText, 0)
'                CosmCurve.Editable = False
                On Error Resume Next
                CosmCurve.Properties("Thickness") = 0

                CosmCurve.Properties("PenColor") = RGB(255, 0, 0)
                CosmCurve.Visible = False
'                CosmCurve.Cosmetic = True
            Else
                CosmCurve.Vertices.Add xText, yText, 0
            End If

            Set GrText = GrSet(i)

            GrText.RotateAxis Bet + InvertSym * Pi, 0, 0, 1, Sym(i).xc, Sym(i).yc, 0
            GrText.MoveRelative xText - Sym(i).xc, yText - Sym(i).yc, 0
            'Add Hatched Box to Symbol
            If Abs(yLoci) < hText / 2 / 1.2 Then
                Call SymbolAddHatchBox(Gr, GrText, i, Sym, xText, yText, Bet, hTextNew)
            End If
        Next i

        With GrCent.Vertices
            .Item(0).x = x0
            .Item(0).y = y0
            .Item(1).x = x1
            .Item(1).y = y1
            .Item(2).x = x2
            .Item(2).y = y2
        End With

        Set GrCent = Nothing
        Set GrCosm = Nothing
        Set CosmCurve = Nothing
        Set GrText = Nothing

End Sub
'##########################################################################
'##########################################################################
'##########################################################################
'##########################################################################
'##########################################################################

' define the number of segment by X-Y coordinate of the point
' Return values iMin - Number of segment,
'                Li -Lenght from begining Curve
'                xlocMin - local coordinate on segment

Private Sub NumSegmByXY(CurInfo As CosmInfo, x As Double, y As Double, iMin As Long, Li As Double, xLocMin As Double)
Dim nV As Long, i As Long
Dim xi#, yi#, xi1#, yi1#, Bet#, sina#, cosa#, dL#
Dim xLoc#, yLoc#
Dim yLocMin#

    yLocMin = 1000000
    nV = CurInfo.nV
    For i = 0 To nV - 2
        xi = CurInfo.xVer(i)
        yi = CurInfo.yVer(i)
        xi1 = CurInfo.xVer(i + 1)
        yi1 = CurInfo.yVer(i + 1)
        dL = CurInfo.dL(i)
        Bet = CurInfo.Bet(i)
'MsgBox ("i=" & CStr(i) & "  xi=" & CStr(xi) & " yi=" & CStr(yi) & "  xi1=" & CStr(xi1) & " yi1=" & CStr(yi1) & " dL=" & CStr(dL) & " Bet=" & CStr(Bet * 180 / Pi))
        sina = Sin(Bet)
        cosa = Cos(Bet)
        yLoc = (y - yi) * cosa - (x - xi) * sina
        xLoc = (y - yi) * sina + (x - xi) * cosa
        If Abs(yLoc) < yLocMin And xLoc > -Eps And xLoc < dL + Eps Then
            yLocMin = Abs(yLoc)
            iMin = i
            Li = CurInfo.lCur(i) + xLoc
            xLocMin = xLoc
        End If
    Next i

End Sub

' define the number of segment by l - lenght from begining of curve
Private Sub NumSegmByL(CurInfo As CosmInfo, L As Double, iMin As Long, xLocMin As Double)
Dim nV As Long, i As Long, Li As Double, Li1 As Double
    nV = CurInfo.nV
    For i = 0 To nV - 2
        Li = CurInfo.lCur(i)
        Li1 = CurInfo.lCur(i + 1)
'MsgBox ("!!!! i=" & CStr(i) & " li=" & CStr(Li) & " li1=" & CStr(Li1))
        If L > Li + Eps And L < Li1 + Eps Then
            iMin = i
            xLocMin = L - Li
            Exit For
        End If
    Next i
End Sub

' define Lenght of text along Curve from L1,L2,L0 for closed curve

Private Sub LenghtOfText(LFull As Double, L0 As Double, L1 As Double, L2 As Double, LText As Double)

 '   LText = Abs(L2 - L1)

Dim L1Tem#, L2Tem#, L0Tem#
    If L0 > L1 And L0 < L2 Then
        Exit Sub
    End If
    If L0 > L2 And L0 < L1 Then
        Exit Sub
    End If
    L0Tem = L0
    L1Tem = L1
    L2Tem = L2

    If L1 > L2 Then
        L1Tem = L1Tem - LFull
    Else
        L2Tem = L2Tem - LFull
    End If
    LText = L2Tem - L1Tem
End Sub

' Correct Lenghts of text along Curve for closed curve
Private Sub CorrectLength(LFull As Double, L0 As Double, L1 As Double, L2 As Double)

    If L0 > L1 And L0 < L2 Then Exit Sub
    If L0 > L2 And L0 < L1 Then Exit Sub

    If (L1 > L2 And L0 > L1) Or (L1 > L2 And L0 < L2) Then
        L1 = L1 - LFull
        Exit Sub
    End If

    If (L2 > L1 And L0 > L2) Or (L2 > L1 And L0 < L1) Then
        L2 = L2 - LFull
        Exit Sub
    End If

End Sub

Private Function Sign(y As Double) As Double
    If Abs(y) < 0.001 Then
        Sign = 0
        Exit Function
    End If
    If y < 0 Then
        Sign = -1#
        Exit Function
    End If
    If y > 0 Then
        Sign = 1#
        Exit Function
    End If
End Function

' Write the Data about cosmetic into Structure for Graphic and Curve and TCW50olyline
Private Sub FormCosmStruct(Gr As Graphic, CurInfo As CosmInfo, LFull As Double, Pr As Integer)
Dim CurveClosed As Boolean
        If Gr.Closed = True Then
            CurveClosed = True
        Else
            CurveClosed = False
        End If
        ' if text create relative cosmetic Curve
        If Pr = 0 Then CurveClosed = True

Dim nV As Long, i As Long, j As Long
        nV = Gr.Vertices.Count
Dim L#, xi#, yi#, xi1#, yi1#, dL#, sina#, cosa#, Bet#
        If CurveClosed = True Then
            CurInfo.nV = nV
            L = 0
            CurInfo.lCur(0) = L
            With Gr.Vertices
                For i = 0 To nV - 2
                    xi = .Item(i).x
                    yi = .Item(i).y
                    xi1 = .Item(i + 1).x
                    yi1 = .Item(i + 1).y
                    dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                    If dL < Eps Then
                        dL = 0
                        Bet = 0
                    Else
                        sina = (yi1 - yi) / dL
                        cosa = (xi1 - xi) / dL
                        Bet = Angle(sina, cosa)
                    End If
                    L = L + dL
                    CurInfo.xVer(i) = xi
                    CurInfo.yVer(i) = yi
                    CurInfo.lCur(i + 1) = L
                    CurInfo.dL(i) = dL
                    CurInfo.Bet(i) = Bet
                Next i
                CurInfo.xVer(nV - 1) = xi1
                CurInfo.yVer(nV - 1) = yi1
            End With
        Else
            CurInfo.nV = nV + 2
Dim k As Long
            k = 0
Dim xPrev#, yPrev#, xLast#, yLast#, LAdd#
            LAdd = 10
            L = 0
            CurInfo.lCur(0) = L
            With Gr.Vertices
                'First added segment
                xi = .Item(0).x
                yi = .Item(0).y
                xi1 = .Item(1).x
                yi1 = .Item(1).y
                dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                If dL < Eps Then
                    For j = 1 To nV - 1
                        xi1 = .Item(j).x
                        yi1 = .Item(j).y
                        dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                        If dL > Eps Then Exit For
                    Next j
                End If
                xPrev = xi1 + (xi - xi1) * (LAdd + dL) / dL
                yPrev = yi1 + (yi - yi1) * (LAdd + dL) / dL
                xi1 = xi
                yi1 = yi
                xi = xPrev
                yi = yPrev
                dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                sina = (yi1 - yi) / dL
                cosa = (xi1 - xi) / dL
                Bet = Angle(sina, cosa)
                L = L + dL
                CurInfo.xVer(k) = xi
                CurInfo.yVer(k) = yi
                CurInfo.lCur(k + 1) = L
                CurInfo.dL(k) = dL
                CurInfo.Bet(k) = Bet
                k = k + 1

                 'Base cosmetic segments
                For i = 0 To nV - 2
                    xi = .Item(i).x
                    yi = .Item(i).y
                    xi1 = .Item(i + 1).x
                    yi1 = .Item(i + 1).y
                    dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                    If dL < Eps Then
                        dL = 0
                        Bet = 0
                    Else
                        sina = (yi1 - yi) / dL
                        cosa = (xi1 - xi) / dL
                        Bet = Angle(sina, cosa)
                    End If
                    L = L + dL
                    CurInfo.xVer(k) = xi
                    CurInfo.yVer(k) = yi
                    CurInfo.lCur(k + 1) = L
                    CurInfo.dL(k) = dL
                    CurInfo.Bet(k) = Bet
                    k = k + 1
                Next i
                'Last added segment
                xi = .Item(nV - 2).x
                yi = .Item(nV - 2).y
                xi1 = .Item(nV - 1).x
                yi1 = .Item(nV - 1).y
                dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                If dL < Eps Then
                    For j = nV - 3 To 0 Step -1
                        xi = .Item(j).x
                        yi = .Item(j).y
                        dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                        If dL > Eps Then Exit For
                    Next j
                End If
                xLast = xi + (xi1 - xi) * (LAdd + dL) / dL
                yLast = yi + (yi1 - yi) * (LAdd + dL) / dL
                xi = xi1
                yi = yi1
                xi1 = xLast
                yi1 = yLast
                dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                sina = (yi1 - yi) / dL
                cosa = (xi1 - xi) / dL
                Bet = Angle(sina, cosa)
                L = L + dL
                CurInfo.xVer(k) = xi
                CurInfo.yVer(k) = yi
                CurInfo.lCur(k + 1) = L
                CurInfo.dL(k) = dL
                CurInfo.Bet(k) = Bet
                k = k + 1
                CurInfo.xVer(k) = xi1
                CurInfo.yVer(k) = yi1
            End With
            ' Edit Content of CurInfo Structure for nonclosed curve
            Call EditCurInfoNonClosed(CurInfo, L)
        End If
        LFull = L
End Sub

' Edit Content of CurInfo Structure for nonclosed curve

Private Sub EditCurInfoNonClosed(CurInfo As CosmInfo, L As Double)
Dim nV As Long, i As Long
Dim LClear#
    LClear = L - 20
    nV = CurInfo.nV
Dim xi#, yi#, xi1#, yi1#
    ' First line segment
    xi = CurInfo.xVer(1)
    yi = CurInfo.yVer(1)
    xi1 = CurInfo.xVer(0)
    yi1 = CurInfo.yVer(0)

    xi1 = xi + (xi1 - xi) * LClear / 10
    yi1 = yi + (yi1 - yi) * LClear / 10
    CurInfo.xVer(0) = xi1
    CurInfo.yVer(0) = yi1
    CurInfo.lCur(1) = LClear
    CurInfo.dL(0) = LClear

    ' Middle segments
Dim dL#, LTem#
    LTem = LClear
    For i = 2 To nV - 2
        dL = CurInfo.dL(i - 1)
        LTem = LTem + dL
        CurInfo.lCur(i) = LTem
    Next i

    ' End line segment
    xi = CurInfo.xVer(nV - 2)
    yi = CurInfo.yVer(nV - 2)
    xi1 = CurInfo.xVer(nV - 1)
    yi1 = CurInfo.yVer(nV - 1)

    xi1 = xi + (xi1 - xi) * LClear / 10
    yi1 = yi + (yi1 - yi) * LClear / 10
    CurInfo.xVer(nV - 1) = xi1
    CurInfo.yVer(nV - 1) = yi1
    CurInfo.lCur(nV - 1) = LTem + LClear
    CurInfo.dL(nV - 2) = LClear

    L = LTem + LClear
End Sub

' define coordinate X,Y From Li for Curve
Private Sub XYFromL(CurInfo As CosmInfo, LFull As Double, Li As Double, x, y)
Dim LTem#, iSegi As Long, xLoci#, yLoci#, xi#, yi#, Bet#
        LTem = Li
        If Li > LFull Then LTem = Li - LFull
        If Li < 0 Then LTem = LFull + Li
        Call NumSegmByL(CurInfo, LTem, iSegi, xLoci)
        Bet = CurInfo.Bet(iSegi)
        xi = CurInfo.xVer(iSegi)
        yi = CurInfo.yVer(iSegi)
        yLoci = 0
        x = xi + xLoci * Cos(Bet) - yLoci * Sin(Bet)
        y = yi + xLoci * Sin(Bet) + yLoci * Cos(Bet)
End Sub

Private Sub SymbolAddHatchBox(Gr As Graphic, GrSym As Graphic, i As Long, Sym() As TextSym, xText As Double, yText As Double, Bet As Double, hText As Double)
Dim x(5) As Double
Dim y(5) As Double
Dim j As Long
Dim xc#, yc#, W#, H#
    If Sym(i).Char = " " Then Exit Sub

    xc = Sym(i).xc
    yc = Sym(i).yc
    W = Sym(i).W
    H = hText

    x(0) = xc - W / 2
    y(0) = yc - 1.2 * H / 2

    x(1) = xc - W / 2
    y(1) = yc + H / 2

    x(2) = xc + W / 2
    y(2) = yc + H / 2

    x(3) = xc + W / 2
    y(3) = yc - 1.2 * H / 2

    x(4) = x(0)
    y(4) = y(0)

Dim GrBox As Graphic
    Set GrBox = Gr.Graphics.Add(11)
    On Error Resume Next
    GrBox.Properties("Thickness") = 0
    GrBox.Cosmetic = True
    With GrBox.Vertices
        For j = 0 To 4
            .Add x(j), y(j), 0
        Next j
    End With
    GrBox.Closed = True

    GrBox.RotateAxis Bet, 0, 0, 1, xc, yc, 0
    GrBox.MoveRelative xText - xc, yText - yc, 0

Dim Col As Long
    Col = Gr.Application.Properties("PaperColor")

    GrBox.Properties("PenColor") = Col
    GrBox.Properties("BrushStyle") = "Solid"
    GrBox.Properties("BrushColor") = Col
    Gr.Graphics.Remove GrSym.Index
    Gr.Graphics.AddGraphic GrSym
'    GrSym.BringToFront

    Set GrBox = Nothing
End Sub

' Define Real Height of text symbol

Private Sub SymRealHeight(Gr As Graphic, hText As Double, H As Double, yc As Double, dyc As Double)

    'Symbol
Dim GrText As Graphic
    Set GrText = Gr.Graphics.AddText("W", 0, 0, 0, hText)
Dim yMaxText#, yMinText#
    With GrText.CalcBoundingBox
        yMaxText = .Max.y
        yMinText = .Min.y
    End With
    Gr.Graphics.Remove GrText.Index

Dim GrExp As Graphic
    Set GrExp = GrText.Explode(0)
Dim yMaxExp#, yMinExp#
    With GrExp.CalcBoundingBox
        yMaxExp = .Max.y
        yMinExp = .Min.y
    End With
    H = yMaxExp - yMinExp
    yc = (yMaxExp + yMinExp) / 2
    dyc = Abs(yMinText - yMinExp)

    GrExp.Delete

    Set GrExp = Nothing
    Set GrText = Nothing
End Sub

' Write the Data about CONSTRUCTION CIRCLE into Structure for Graphic and Curve and TCW50olyline

Private Sub FormConCircStruct(GrCirc As Graphic, CurInfo As CosmInfo, LFull As Double)

Dim xi#, yi#, xi1#, yi1#, L#, dL#, sina#, cosa#, Bet#
Dim xc#, yc#, x1#, y1#
    With GrCirc.Vertices
        xc = .Item(0).x
        yc = .Item(0).y
        x1 = .Item(1).x
        y1 = .Item(1).y
    End With
Dim nV As Long, i As Long
    nV = 41
Dim R#, dfi#
    R = Sqr((x1 - xc) * (x1 - xc) + (y1 - yc) * (y1 - yc))
    LFull = 2 * Pi * R
    dfi = 2 * Pi / (nV - 1)

    CurInfo.nV = nV
    L = 0
    CurInfo.lCur(0) = L
    For i = 0 To nV - 2
        xi = xc + R * Cos(dfi * i)
        yi = yc + R * Sin(dfi * i)
        xi1 = xc + R * Cos(dfi * (i + 1))
        yi1 = yc + R * Sin(dfi * (i + 1))
        dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
        sina = (yi1 - yi) / dL
        cosa = (xi1 - xi) / dL
        Bet = Angle(sina, cosa)
        L = L + dL
        CurInfo.xVer(i) = xi
        CurInfo.yVer(i) = yi
        CurInfo.lCur(i + 1) = L
        CurInfo.dL(i) = dL
        CurInfo.Bet(i) = Bet
    Next i
    CurInfo.xVer(nV - 1) = xi1
    CurInfo.yVer(nV - 1) = yi1

End Sub

' Define active view

Private Sub DefineActView(Gr As Graphic, Vi As view)
Dim Vis As Views
    Set Vis = Gr.Drawing.Views
Dim hVi As Long, hActVi As Long
    hActVi = TCWViewActive
Dim ViCount As Long, i As Long
    ViCount = Vis.Count
    For i = 0 To ViCount - 1
        hVi = TCWViewAt(i + 1)
        If hVi = hActVi Then
            Set Vi = Vis(i)
            Exit For
        End If
    Next i
    Set Vis = Nothing
End Sub

' if connected was deleted or changed its ID dedine connection to new graphic
' if it concident with 0-Vertices of TextAlong-graphic
' function return ID new connected curve or -1
Private Function SnapToNearestGraphic(Gr As Graphic) As Long
    SnapToNearestGraphic = -1
Dim TSets As TieSets
Dim Vi As view

    Call DefineActView(Gr, Vi)

    ' if was changed ID connected graphic
    ' then define New graphic connected with text graphic
    ' by 0-vertex of the text graphic
'MsgBox ("111")
Dim x0#, y0#
    With Gr.Vertices
        .UseWorldCS = True
        x0 = .Item(0).x
        y0 = .Item(0).y
    End With
Dim xV#, yV#
        Vi.WorldToView x0, y0, 0, xV, yV, 0
Dim PicRes As PickResult
        Set PicRes = Vi.PickPoint(xV, yV, 0.5)
Dim PicCount As Long, i As Long
        PicCount = PicRes.Count
'MsgBox ("PicCount=" & CStr(PicCount))
Dim Gr1 As Graphic
Dim GrType$
Dim Gr1ID As Long
        For i = 0 To PicCount - 1
            Set Gr1 = PicRes(i).Graphic
            GrType = Gr1.Type
            If GrType <> "TextAlong.Curve" Then
                If GrType = "GRAPHIC" Or GrType = "CIRCLE" Or GrType = "ARC" Or GrType = "TCW30CURVE" Or GrType = "TCW50Polyline" Then
                    Gr.Properties("GrConType") = GrType
                    Gr1ID = Gr1.ID
                    Gr.Properties("GrConID") = Gr1ID
                    Gr.Properties("GrConIDOld") = Gr1ID
                    SnapToNearestGraphic = Gr1ID
                    Set TSets = Gr.Drawing.TieSets
                    TSets.Add "Curve.TextTie", Gr1, Gr, 0, 0
               End If
            End If
        Next i
LL:
        Set Gr1 = Nothing
        Set PicRes = Nothing
        Set Vi = Nothing
        Set TSets = Nothing
End Function

' Define if exist connection this graphic - TextAlongCurve
' with connected Curve. This needed for RubberStamp and Copy/Paste
Private Function ConnectionExist(Gr As Graphic, GrConID As Long, TieWasted As Boolean) As Long
    ConnectionExist = GrConID
'MsgBox ("ConnectionExist grID=" & CStr(Gr.ID))
Dim TSets As TieSets
Dim TSet As TieSet
    TieWasted = True
    On Error GoTo ErrHandler
    Set TSets = Gr.Drawing.TieSets
    Set TSet = Nothing
    On Error Resume Next
    Set TSet = TSets.TieSet(GrConID, Gr.ID)
    If TSet Is Nothing Then
        ConnectionExist = -1
    Else
        TieWasted = TSet.Flag(imsiTieWasted)
    End If
    Set TSet = Nothing
    Set TSets = Nothing
    Exit Function
ErrHandler:
'    MsgBox "Error: " + Err.Description
    Set TSet = Nothing
    Set TSets = Nothing
End Function

'##########################################################################
'##########################################################################
'##########################################################################
'##########################################################################
'##########################################################################
' Draw Text along Cosmetic curve
Private Sub TextAlongCoismeticCurve(Gr As Graphic, GrSet As GraphicSet, Sym() As TextSym, StrLen As Long, hText As Double)
'MsgBox ("TextAlongCoismeticCurve - Begin")
Dim GrProps As Properties
    Set GrProps = Gr.Properties
Dim MyText$, MyTextOld$
Dim HeightText#, HeightTextOld#
    MyText = GrProps("MyText")
    MyTextOld = GrProps("MyTextOld")
    HeightText = GrProps("HeightText")
    HeightTextOld = GrProps("HeightTextOld")
Dim TextChanged As Boolean
    TextChanged = False
    If MyText <> MyTextOld Or HeightText <> HeightTextOld Then
        TextChanged = True
    End If

'Begin the old Center graphic
Dim GrBaseCurve As Graphic
Dim GrCent As Graphic
Dim GrCount As Long, i As Long

        ' Delete Base Graphic Curve
        GrCount = Gr.Graphics.Count
        For i = 0 To GrCount - 1
            Set GrBaseCurve = Gr.Graphics(i)
            If GrBaseCurve.Type = "TCW30CURVE" Then
                Exit For
            End If
        Next i

        GrCount = Gr.Graphics.Count
        For i = 0 To GrCount - 1
            Set GrCent = Gr.Graphics(i)
            If GrCent.Type = "GRAPHIC" And GrCent.Cosmetic = False Then
                If GrCent.Vertices.Count = 3 Then
                    Exit For
                End If
            End If
        Next i
        GrBaseCurve.Update
Dim GrCosm As Graphic
        Set GrCosm = GrBaseCurve.Graphics(1)

Dim nV As Long
        nV = GrCosm.Vertices.Count
'MsgBox ("nV=" & CStr(nV))
Dim xi#, yi#, xi1#, yi1#, dL#, L#, Bet#
Dim sina#, cosa#
Dim CurInfo As CosmInfo
ReDim CurInfo.dL(nV + 5)
ReDim CurInfo.lCur(nV + 5)
ReDim CurInfo.xVer(nV + 5)
ReDim CurInfo.yVer(nV + 5)
ReDim CurInfo.Bet(nV + 5)
Dim LFull#
        Call FormCosmStruct(GrCosm, CurInfo, LFull, 0)

'MsgBox ("LFull=" & CStr(LFull))
' Define the Parameters of the text
Dim x0#, y0#, x1#, y1#, x2#, y2#
        With Gr.Vertices
            x0 = .Item(0).x
            y0 = .Item(0).y
            x1 = .Item(1).x
            y1 = .Item(1).y
            x2 = .Item(2).x
            y2 = .Item(2).y
            .Item(0).Editable = False
            .Item(1).Editable = False
            .Item(2).Editable = False
        End With
Dim L0#, L1#, L2#
        L0 = LFull / 2
        L1 = 0
        L2 = LFull

Dim iSegi As Long, xLoci#, yLoci#
        ' define Coordinate xi,yi from Li
        Call XYFromL(CurInfo, LFull, L0, x0, y0)
        Call XYFromL(CurInfo, LFull, L1, x1, y1)
        Call XYFromL(CurInfo, LFull, L2, x2, y2)
        ' Assign new location for base vertices of text
        With Gr.Vertices
            .Item(0).x = x0
            .Item(0).y = y0
            .Item(1).x = x1
            .Item(1).y = y1
            .Item(2).x = x2
            .Item(2).y = y2
        End With

' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
' Define real Height of Symbol
Dim hTextNew#, ycNew#, dycNew#
        Call SymRealHeight(Gr, hText, hTextNew, ycNew, dycNew)
        For i = 0 To StrLen - 1
            Sym(i).yc = ycNew - dycNew / 2
        Next i
        hText = 1.2 * hTextNew
' @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

Dim InvertSym%
        InvertSym = Gr.Properties("InvertSym")

        If StrLen > 1 Then
            dL = (L2 - L1) / (StrLen - 1)
        End If
        If StrLen = 1 Then ' if String=single symbol
            dL = (L2 - L1) / 2
        End If

        For i = 0 To StrLen - 1
            If StrLen > 1 Then
                L = L1 + i * dL
            End If
            If StrLen = 1 Then  ' if String=single symbol
                L = L1 + (i + 1) * dL
            End If

Dim xText#, yText#
Dim GrText As Graphic
            Call NumSegmByL(CurInfo, L, iSegi, xLoci)
'MsgBox ("i=" & CStr(i) & " l=" & CStr(L) & " isegi=" & CStr(iSegi))
            Bet = CurInfo.Bet(iSegi)
            xi = CurInfo.xVer(iSegi)
            yi = CurInfo.yVer(iSegi)
            ' if location = Middle
            yLoci = 0

            xText = xi + xLoci * Cos(Bet) - yLoci * Sin(Bet)
            yText = yi + xLoci * Sin(Bet) + yLoci * Cos(Bet)

            Set GrText = GrSet(i)

            GrText.RotateAxis Bet + InvertSym * Pi, 0, 0, 1, Sym(i).xc, Sym(i).yc, 0
            GrText.MoveRelative xText - Sym(i).xc, yText - Sym(i).yc, 0
            'Add Hatched Box to Symbol
'            Call SymbolAddHatchBox(Gr, GrText, i, Sym, xText, yText, Bet, hTextNew)
        Next i

        With GrCent.Vertices
            .Item(0).x = x0
            .Item(0).y = y0
            .Item(1).x = x1
            .Item(1).y = y1
            .Item(2).x = x2
            .Item(2).y = y2
        End With
        GrBaseCurve.Visible = False
        Set GrCent = Nothing
        Set GrBaseCurve = Nothing
        Set GrCosm = Nothing
        Set GrText = Nothing
'MsgBox ("TextAlongCoismeticCurve - End")

End Sub
'##########################################################################
'##########################################################################
'##########################################################################
'##########################################################################
'##########################################################################

' Define new values of properties if Drawing Units was changed
Private Sub ChangingUnits(Gr As Graphic)
Dim GrProps As Properties
        Set GrProps = Gr.Properties
Dim Space%
        Space = Gr.Drawing.Properties("TileMode") ' Modal or Paper space
Dim UnitName$
        If Space <> 1 Then
            UnitName = Gr.Drawing.Properties("PaperLinearUnitName")
        Else
            UnitName = Gr.Drawing.Properties("LinearUnitName")
        End If
Dim UnitNameOld$
        UnitNameOld = GrProps("Units")
'MsgBox ("UnitNameOld=" & UnitNameOld & "   UnitNameNew=" & UnitName)
        'If New graphic
        If UnitNameOld = "" Then UnitNameOld = UnitName
        GrProps("Units") = UnitName

Dim UnitScale#
        UnitScale = 1
Dim x0#, y0#, x1#, y1#, x2#, y2#
        With Gr.Vertices
            x0 = .Item(0).x
            y0 = .Item(0).y
            x1 = .Item(1).x
            y1 = .Item(1).y
            x2 = .Item(2).x
            y2 = .Item(2).y
        End With
Dim L#, LOld#, TextOffset#, HeightText#, Thick#, HeightTextOld#
        L = Sqr((x1 - x2) * (x1 - x2) + (y1 - y2) * (y1 - y2))
        UnitScale = 1
        If UnitName <> UnitNameOld Then
            LOld = GrProps("LOld")
            If Abs(LOld - L) > 0.00001 Then
                UnitScale = UnitToUnit(UnitName, UnitNameOld)
                TextOffset = GrProps("TextOffset")
                HeightText = GrProps("HeightText")
                HeightTextOld = GrProps("HeightTextOld")
                Thick = GrProps("Thick")
                ' Define new values of properties
'                GrProps("LOld") = LOld * UnitScale
                GrProps("TextOffset") = TextOffset * UnitScale
                GrProps("HeightText") = HeightText * UnitScale
                GrProps("HeightTextOld") = HeightTextOld * UnitScale
                GrProps("Thick") = Thick * UnitScale
'MsgBox ("UnitScale=" & CStr(UnitScale) & "  a=" & CStr(a))
            End If
        End If
        GrProps("LOld") = L
        If UnitScale = 1 Then
            Set GrProps = Nothing
            Exit Sub
        End If

' Edit the TieData
Dim GrConID As Long
Dim GrCon As Graphic
        GrConID = GrProps("GrConID")

        If GrConID = -1 Then
            Set GrProps = Nothing
            Exit Sub
        End If

        Set GrCon = Nothing
        On Error Resume Next
        Set GrCon = Gr.Drawing.Graphics.GraphicFromID(GrConID)
        If GrCon Is Nothing Then
            Set GrCon = Nothing
            Set GrProps = Nothing
            Exit Sub
        End If
Dim TSets As TieSets
        Set TSets = Gr.Drawing.TieSets
Dim TSet As TieSet
        Set TSet = Nothing
        On Error Resume Next
        Set TSet = TSets.TieSet(GrConID, Gr.ID)
        If TSet Is Nothing Then
            Set GrCon = Nothing
            Set GrProps = Nothing
            Set TSet = Nothing
            Set TSets = Nothing
            Exit Sub
        End If
Dim TSet1 As TieSet
        Set TSet1 = TSets.TieSet(Gr.ID, GrConID)
Dim varData As Variant
Dim Tie As Tie
        Set Tie = TSet(0)
        varData = Tie.Data
Dim varData1 As Variant
Dim Tie1 As Tie
        Set Tie1 = TSet1(0)
        varData1 = Tie1.Data
Dim LFullPrev#, x0Prev#, y0Prev#, x1Prev#, y1Prev#
        LFullPrev = varData(0).LFullPrev
        x0Prev = varData(0).x0Prev     ' for Curve or TCW50Polyline
        y0Prev = varData(0).y0Prev     ' for Curve or TCW50Polyline
        x1Prev = varData(0).x1Prev     ' for Curve or TCW50Polyline
        y1Prev = varData(0).y1Prev     ' for Curve or TCW50Polyline

        varData(0).LFullPrev = LFullPrev * UnitScale
        varData(0).x0Prev = x0Prev * UnitScale
        varData(0).y0Prev = y0Prev * UnitScale
        varData(0).x1Prev = x1Prev * UnitScale
        varData(0).y1Prev = y1Prev * UnitScale

        varData1(0).LFullPrev = LFullPrev * UnitScale
        varData1(0).x0Prev = x0Prev * UnitScale
        varData1(0).y0Prev = y0Prev * UnitScale
        varData1(0).x1Prev = x1Prev * UnitScale
        varData1(0).y1Prev = y1Prev * UnitScale

        Tie.Data = varData(0)
        Tie1.Data = varData1(0)

        Set GrCon = Nothing
        Set GrProps = Nothing
        Set Tie = Nothing
        Set Tie1 = Nothing
        Set TSet = Nothing
        Set TSet1 = Nothing
        Set TSets = Nothing

End Sub

'Calculate the Units scale if it changes

Private Function UnitToUnit(UnitName As String, UnitNameOld As String) As Double
    UnitToUnit = 1
'MsgBox ("UnitNameOld=" & UnitNameOld & "   UnitNameNew=" & UnitName)
    If UnitNameOld = "in" Or UnitNameOld = """" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 1
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 1 / 12
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 1 / 36
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 1 / (12 * 5280)
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 25.4
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 2.54
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 2.54 / 100
            Exit Function
        End If
    End If

    If UnitNameOld = "ft" Or UnitNameOld = "'" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 12
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 1
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 1 / 3
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 1 / 5280
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 12 * 25.4
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 12 * 2.54
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 12 * 2.54 / 100
            Exit Function
        End If
    End If

    If UnitNameOld = "yd" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 3 * 12
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 3
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 1
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 1 / 5280 / 3
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 3 * 12 * 25.4
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 3 * 12 * 2.54
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 3 * 12 * 2.54 / 100
            Exit Function
        End If
    End If
' Add Miles

    If UnitNameOld = "mm" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 1 / 25.4
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 1 / 25.4 / 12
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 1 / 25.4 / 12 / 3
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 1 / 25.4 / 12 / 5280
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 1
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 1 / 10
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 1 / 1000
            Exit Function
        End If
    End If

    If UnitNameOld = "cm" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 1 / 2.54
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 1 / 2.54 / 12
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 1 / 2.54 / 12 / 3
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 1 / 2.54 / 12 / 5280
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 10
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 1
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 1 / 100
            Exit Function
        End If
    End If

    If UnitNameOld = "m" Then
        If UnitName = """" Or UnitName = "in" Then
            UnitToUnit = 1000 / 25.4
            Exit Function
        End If
        If UnitName = "ft" Or UnitName = "'" Then
            UnitToUnit = 1000 / 25.4 / 12
            Exit Function
        End If
        If UnitName = "yd" Then
            UnitToUnit = 1000 / 25.4 / 12 / 3
            Exit Function
        End If
        If UnitName = "mi" Then
            UnitToUnit = 1000 / 25.4 / 12 / 5280
            Exit Function
        End If
        If UnitName = "mm" Then
            UnitToUnit = 1000
            Exit Function
        End If
        If UnitName = "cm" Then
            UnitToUnit = 100
            Exit Function
        End If
        If UnitName = "m" Then
            UnitToUnit = 1
            Exit Function
        End If
    End If
        UnitToUnit = 1

End Function


Examples - Text Along Curve Tool - frmTextAlong.frm

frmTextAlong.frm

Text Along Curve Tool Example

VERSION 5.00
Begin VB.Form frmTextAlong
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Text Properties"
   ClientHeight    =   4350
   ClientLeft      =   6420
   ClientTop       =   2895
   ClientWidth     =   3465
   KeyPreview      =   -1  'True
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   4350
   ScaleWidth      =   3465
   Begin VB.TextBox TextOffset
      Height          =   288
      Left            =   120
      TabIndex        =   16
      Text            =   "0.0"
      Top             =   3360
      Width           =   1092
   End
   Begin VB.ComboBox FontText
      Height          =   288
      ItemData        =   "frmTextAlong.frx":0000
      Left            =   2040
      List            =   "frmTextAlong.frx":008B
      TabIndex        =   14
      Text            =   "Combo1"
      Top             =   2640
      Width           =   1212
   End
   Begin VB.ComboBox ModeText
      Height          =   288
      ItemData        =   "frmTextAlong.frx":0295
      Left            =   2040
      List            =   "frmTextAlong.frx":02A2
      TabIndex        =   12
      Text            =   "Combo1"
      Top             =   1920
      Width           =   1212
   End
   Begin VB.ComboBox StyleText
      Height          =   288
      ItemData        =   "frmTextAlong.frx":02C4
      Left            =   2040
      List            =   "frmTextAlong.frx":02D4
      TabIndex        =   10
      Text            =   "Combo1"
      Top             =   1200
      Width           =   1212
   End
   Begin VB.CheckBox InvertSym
      Caption         =   "Flip Text"
      Height          =   252
      Left            =   2040
      TabIndex        =   9
      Top             =   3360
      Width           =   1332
   End
   Begin VB.TextBox Thick
      Height          =   288
      Left            =   120
      TabIndex        =   7
      Text            =   "0.0"
      Top             =   2640
      Width           =   1092
   End
   Begin VB.TextBox HeightText
      Height          =   288
      Left            =   120
      TabIndex        =   5
      Text            =   "0.2"
      Top             =   1920
      Width           =   1092
   End
   Begin VB.ComboBox Location
      Height          =   288
      ItemData        =   "frmTextAlong.frx":02FC
      Left            =   120
      List            =   "frmTextAlong.frx":0309
      TabIndex        =   3
      Text            =   "Above"
      Top             =   1200
      Width           =   1092
   End
   Begin VB.TextBox MyText
      Height          =   288
      Left            =   120
      TabIndex        =   2
      Text            =   "Text1"
      Top             =   480
      Width           =   3132
   End
   Begin VB.CommandButton cmdOK
      Caption         =   "OK"
      Height          =   375
      Left            =   360
      TabIndex        =   0
      Top             =   3840
      Width           =   1092
   End
   Begin VB.CommandButton cmdCancel
      Caption         =   "Cancel"
      Height          =   375
      Left            =   1800
      TabIndex        =   1
      Top             =   3840
      Width           =   1212
   End
   Begin VB.Label Label8
      Caption         =   "Text"
      Height          =   228
      Left            =   108
      TabIndex        =   18
      Top             =   192
      Width           =   492
   End
   Begin VB.Label Label7
      Caption         =   "Text Offset"
      Height          =   252
      Left            =   240
      TabIndex        =   17
      Top             =   3120
      Width           =   852
   End
   Begin VB.Label Label6
      Caption         =   "Text Font"
      Height          =   252
      Left            =   2280
      TabIndex        =   15
      Top             =   2400
      Width           =   732
   End
   Begin VB.Label Label5
      Caption         =   "Text Mode"
      Height          =   252
      Left            =   2280
      TabIndex        =   13
      Top             =   1680
      Width           =   852
   End
   Begin VB.Label Label4
      Caption         =   "Text Style"
      Height          =   252
      Left            =   2280
      TabIndex        =   11
      Top             =   960
      Width           =   732
   End
   Begin VB.Label Label3
      Caption         =   "Thickness"
      Height          =   252
      Left            =   120
      TabIndex        =   8
      Top             =   2400
      Width           =   1092
   End
   Begin VB.Label Label2
      Caption         =   "Text Height"
      Height          =   252
      Left            =   120
      TabIndex        =   6
      Top             =   1680
      Width           =   852
   End
   Begin VB.Label Label1
      Caption         =   "Text  Location"
      Height          =   252
      Left            =   120
      TabIndex        =   4
      Top             =   960
      Width           =   1092
   End
End
Attribute VB_Name = "frmTextAlong"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2000                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/

' Storage for read-only property indicating whether
' or not the dialog box was cancelled. Default is
' False. Note that the declaration is Private, so
' that the value cannot be set from the OLE client
' application. The client reads the value using the
' DialogCancelled property.
Private blnDialogCanceled As Boolean

' Read-only property indicating cancellation of the
' dialog.
Property Get DialogCanceled() As Boolean
    DialogCanceled = blnDialogCanceled
End Property

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 27 Then
        blnDialogCanceled = True
        Me.Hide
    End If
    If KeyAscii = 13 Then
        blnDialogCanceled = False
        Me.Hide
    End If
End Sub

Private Sub cmdCancel_Click()
    ' Set the value of the read-only property that
    ' tells the caller the dialog was cancelled.
    blnDialogCanceled = True
    Me.Hide
End Sub

Private Sub cmdOK_Click()
Dim TH#, TextH$
    TH = 0
    TextH = HeightText.Text
    On Error Resume Next
    TH = CDbl(TextH)
    If TH = 0 Then
        MsgBox "Please enter a number in the field 'Text Height'", , "TurboCAD Professional"
        Exit Sub
    End If
    If MyText.Text = "" Then
        MsgBox "Text must have one symbol at least", , "TurboCAD Professional"
        Exit Sub
    End If

    blnDialogCanceled = False
    Me.Hide

End Sub

Private Sub Form_Load()
    blnDialogCanceled = True
'Dim i%, iDef%
'    For i = 0 To ScheduleType.ListCount - 1
'        If ScheduleType.List(i) = TypeSchedule Then iDef = i
'    Next i
'    ScheduleType.ListIndex = iDef

End Sub


Examples - Text Along Curve Tool - modTextAlong.bas

modTextAlong.bas

Text Along Curve Tool Example

Attribute VB_Name = "modTextAlong"
Option Explicit
'/******************************************************************/
'/*                                                                */
'/*                      TurboCAD for Windows                      */
'/*                   Copyright (c) 1993 - 2000                    */
'/*             International Microcomputer Software, Inc.         */
'/*                            (IMSI)                              */
'/*                      All rights reserved.                      */
'/*                                                                */
'/******************************************************************/
Type TextSym
    Char As String
    H As Double
    W As Double
    xMin As Double
    yMin As Double
    xc As Double
    yc As Double
End Type
Type CosmInfo
    nV As Long
    lCur() As Double
    dL() As Double
    xVer() As Double
    yVer() As Double
    Bet() As Double
End Type
' DLL Entry point
Sub Main()
End Sub


Examples - Text Along Curve Tool - CurveTextTie.cls

CurveTextTie.cls

Text Along Curve Tool Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "TextTie"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
Implements ITurboCADSmartTieServer

Private Declare Function TCWDrawingActive Lib "TCAPI70.dll" () As Long
Private Declare Function TCWGraphicAt Lib "TCAPI70.dll" (ByVal d As Long, ByVal Index As Long) As Long
Private Declare Function TCWVertexAt Lib "TCAPI70.dll" (ByVal g As Long, ByVal Index As Long) As Long

Private Declare Function TCWGraphicHandleFromID Lib "TCAPI70.dll" (ByVal gID As Long) As Long

Private Declare Sub prVertexSetSomeFlags Lib "DBAPI70.dll" (ByVal hVer As Long, ByVal FlagOn As Long, ByVal FlagOff As Long)

Private Declare Function GraphicGetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long) As Long
Private Declare Function GraphicSetMatrix Lib "DBAPI70.dll" (ByVal hGr As Long, ByVal hMat As Long) As Boolean
Private Declare Function MatrixEqual Lib "DBAPI70.dll" (ByVal hM1 As Long, ByVal hM2 As Long) As Boolean

'Useful math constants
Const Pi# = 3.14159265
Const Eps = 0.0000001
Private Type CosmInfo
    nV As Long
    lCur() As Double
    dL() As Double
    xVer() As Double
    yVer() As Double
    Bet() As Double
End Type

Public Type VertexTieData
    idVertPoly As Long ' define the least nearest index of segment's vertex on polygon
    xLocRelPrev As Double ' Previous local coordinate on line segment
    AnglePrev As Double ' Previous angle of line segment
    fiMidPrev As Double ' Previous angle for middle text point for Circle or Arc
    xcPrev As Double    ' Previous Xc for Circle or Arc
    ycPrev As Double    ' Previous Yc for Circle or Arc
    LFullPrev As Double     ' Previous full length for Curve or TCW50Polyline
    x0Prev As Double    ' Previous x0 for Curve or TCW50Polyline
    y0Prev As Double    ' Previous y0 for Curve or TCW50Polyline
    x1Prev As Double    ' Previous x1 for Curve or TCW50Polyline
    y1Prev As Double    ' Previous y1 for Curve or TCW50Polyline
    L0RelPrev As Double  ' Previous relative Length coordinate for the center vertex of the text
    L1RelPrev As Double ' Previous relative Length coordinate for the first bounded vertex of the text
    L2RelPrev As Double ' Previous relative Length coordinate for the first bounded vertex of the text
End Type

Private idVTie As String

Private TSets As TieSets
Private TSet  As TieSet
Private Tie   As Tie
Private ActDr   As Drawing
Private tieData As VertexTieData

Private VersSbj As Vertices
Private VersSbd As Vertices

Private Grs   As Graphics
Private GrSbj As Graphic
Private GrSbd As Graphic

Private hDr As Long
Private hGrSbj As Long
Private hGrSbd As Long
Private hMatSbj As Long
Private hMatSbd As Long

Private Function Clear()

    Set VersSbj = Nothing
    Set VersSbd = Nothing

    Set GrSbj = Nothing
    Set GrSbd = Nothing
    Set Grs = Nothing
    Set Tie = Nothing
    Set TSet = Nothing
    Set TSets = Nothing
    Set ActDr = Nothing

End Function

Private Function ITurboCADSmartTieServer_AddTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, ByVal lType As Long) As Boolean
'MsgBox ("AddTie")
Dim varData As Variant
    Set ActDr = pIDispDwg
    Set GrSbj = Nothing
    Set GrSbd = Nothing
    On Error Resume Next
    Set GrSbj = ActDr.Graphics.GraphicFromID(idSbj)
    On Error Resume Next
    Set GrSbd = ActDr.Graphics.GraphicFromID(idSbd)
    If GrSbj Is Nothing Then
        ITurboCADSmartTieServer_AddTie = True
        Clear
        Exit Function
    End If
    If GrSbd Is Nothing Then
        ITurboCADSmartTieServer_AddTie = True
        Clear
        Exit Function
    End If

Dim x0#, y0#, x1#, y1#, x2#, y2#, xc#, yc#, x0Text#, y0Text#
Dim L#, sina#, cosa#
Dim xLoc0Text#, AnglePrev#, fiMidPrev#, xcPrev#, ycPrev#
Dim LFullPrev#, x0Prev#, y0Prev#, x1Prev#, y1Prev#, L0RelPrev#, L1RelPrev#, L2RelPrev#
    xLoc0Text = 0#
    AnglePrev = 0#
    fiMidPrev = 0#
    xcPrev = 0#
    ycPrev = 0#
    LFullPrev = 0#
    x0Prev = 0#
    y0Prev = 0#
    x1Prev = 0#
    y1Prev = 0#
    L0RelPrev = 0#
    L1RelPrev = 0#
    L2RelPrev = 0#

Dim ConVertex As Long
    ConVertex = 0
Dim GrSbjType$
    GrSbjType = GrSbj.Type
    If GrSbjType = "TextAlong.Curve" Then GoTo WW
Dim GrConType$
    GrConType = GrSbjType 'GrSbd.Properties("GrConType")
'#######################################################################
    ' if connected graphic is Curve or TCW50Polyline
    If GrConType = "GRAPHIC" Or GrConType = "CIRCLE" Or GrConType = "ARC" Or GrConType = "TCW30CURVE" Or GrConType = "TCW50Polyline" Then
Dim GrCosm As Graphic
        If GrConType = "TCW30CURVE" Then
            Set GrCosm = GrSbj.Graphics(1)
        End If
        If GrConType = "TCW50Polyline" Then
            Set GrCosm = GrSbj.Graphics(0)
        End If
        If (GrConType = "CIRCLE" And GrSbj.Unbounded = False) Or GrConType = "ARC" Then
            On Error Resume Next
            Set GrCosm = GrSbj.Duplicate
            If ActDr.Properties("TileMode") = 1 Then
                GrCosm.Properties("Thickness") = 0
                GrCosm.Update
            End If
            GrCosm.Properties("BrushStyle") = ""
            GrCosm.Update
            ActDr.Graphics.Remove GrCosm.Index
            Set GrCosm = GrCosm.Explode(0)
        End If

Dim nVCosm As Long, i As Long
        If GrSbj.Unbounded = True And GrConType = "CIRCLE" Then
            nVCosm = 50
        Else
            If GrConType = "GRAPHIC" Then
                nVCosm = GrSbj.Vertices.Count
            Else
                nVCosm = GrCosm.Vertices.Count
            End If
        End If
Dim CurInfo As CosmInfo
ReDim CurInfo.dL(nVCosm + 5)
ReDim CurInfo.lCur(nVCosm + 5)
ReDim CurInfo.xVer(nVCosm + 5)
ReDim CurInfo.yVer(nVCosm + 5)
ReDim CurInfo.Bet(nVCosm + 5)
        If GrSbj.Unbounded = True And GrConType = "CIRCLE" Then
            Call FormConCircStruct(GrSbj, CurInfo, LFullPrev)
        Else
            If GrConType = "GRAPHIC" Then
                Call FormCosmStruct(GrSbj, CurInfo, LFullPrev)
            Else
                Call FormCosmStruct(GrCosm, CurInfo, LFullPrev)
            End If

            If GrConType = "CIRCLE" Or GrConType = "ARC" Then
                GrCosm.Deleted = True
            End If
        End If

        If GrConType = "CIRCLE" Then
            With GrSbj.Vertices
                x0Prev = .Item(0).x
                y0Prev = .Item(0).y
                x1Prev = .Item(1).x
                y1Prev = .Item(1).y
            End With
        Else
            x0Prev = CurInfo.xVer(0)
            y0Prev = CurInfo.yVer(0)
            x1Prev = CurInfo.xVer(1)
            y1Prev = CurInfo.yVer(1)
        End If

        ' Define parameters for TextAlongCurve
        With GrSbd.Vertices
            x0 = .Item(0).x
            y0 = .Item(0).y
            x1 = .Item(1).x
            y1 = .Item(1).y
            x2 = .Item(2).x
            y2 = .Item(2).y
        End With
Dim L0#, L1#, L2#
Dim iMin As Long, xLocMin#
        Call NumSegmByXY(CurInfo, x0, y0, iMin, L0, xLocMin)
        Call NumSegmByXY(CurInfo, x1, y1, iMin, L1, xLocMin)
        Call NumSegmByXY(CurInfo, x2, y2, iMin, L2, xLocMin)

        L0RelPrev = L0 / LFullPrev
        L1RelPrev = L1 / LFullPrev
        L2RelPrev = L2 / LFullPrev
'MsgBox ("Add Tie LFullPrev=" & CStr(LFullPrev))
'MsgBox (" Add Tie L0Rel=" & CStr(L0RelPrev) & "  L1Rel=" & CStr(L1RelPrev) & "  L2Rel=" & CStr(L2RelPrev))
        Set GrCosm = Nothing
    End If
'#######################################################################
    Set TSets = ActDr.TieSets
    Set TSet = TSets.TieSet(idSbj, idSbd)
        tieData.idVertPoly = ConVertex ' for Polygon
        If Abs(L) < Eps Then
            tieData.xLocRelPrev = 1
        Else
            tieData.xLocRelPrev = xLoc0Text / L ' for Polygon
        End If
        tieData.AnglePrev = AnglePrev   ' for Polygon
        tieData.fiMidPrev = fiMidPrev   ' for Circle or Arc
        tieData.xcPrev = xcPrev   ' for Circle or Arc
        tieData.ycPrev = ycPrev   ' for Circle or Arc
        tieData.LFullPrev = LFullPrev   ' for Curve or TCW50Polyline
        tieData.x0Prev = x0Prev   ' for Curve or TCW50Polyline
        tieData.y0Prev = y0Prev   ' for Curve or TCW50Polyline
        tieData.x1Prev = x1Prev   ' for Curve or TCW50Polyline
        tieData.y1Prev = y1Prev   ' for Curve or TCW50Polyline
        tieData.L0RelPrev = L0RelPrev   ' for Curve or TCW50Polyline
        tieData.L1RelPrev = L1RelPrev  ' for Curve or TCW50Polyline
        tieData.L2RelPrev = L2RelPrev  ' for Curve or TCW50Polyline
        varData = tieData
        TSet.AddTie idVTie, 1, varData

    Set TSet = TSets.TieSet(idSbd, idSbj)
        tieData.idVertPoly = ConVertex  ' for Polygon
        If Abs(L) < Eps Then
            tieData.xLocRelPrev = 1
        Else
            tieData.xLocRelPrev = xLoc0Text / L ' for Polygon
        End If
        tieData.AnglePrev = AnglePrev   ' for Polygon
        tieData.fiMidPrev = fiMidPrev   ' for Circle or Arc
        tieData.xcPrev = xcPrev   ' for Circle or Arc
        tieData.ycPrev = ycPrev   ' for Circle or Arc
        tieData.LFullPrev = LFullPrev   ' for Curve or TCW50Polyline
        tieData.x0Prev = x0Prev   ' for Curve or TCW50Polyline
        tieData.y0Prev = y0Prev   ' for Curve or TCW50Polyline
        tieData.x1Prev = x1Prev   ' for Curve or TCW50Polyline
        tieData.y1Prev = y1Prev   ' for Curve or TCW50Polyline
        tieData.L0RelPrev = L0RelPrev   ' for Curve or TCW50Polyline
        tieData.L1RelPrev = L1RelPrev  ' for Curve or TCW50Polyline
        tieData.L2RelPrev = L2RelPrev  ' for Curve or TCW50Polyline
        varData = tieData
        TSet.AddTie idVTie, 1, varData

'    UpdateTie TSet
WW:
    ITurboCADSmartTieServer_AddTie = True
    Clear

End Function

Private Function ITurboCADSmartTieServer_CopyTie(ByVal pIDispDwg As Object, ByVal idSbjSrc As Long, ByVal idSbdSrc As Long, ByVal idSbjTrg As Long, ByVal idSbdTrg As Long) As Boolean

'MsgBox ("CopyTie")
'    Set ActDr = pIDispDwg
'    Set Grs = ActDr.Graphics
'    Set GrSbj = Grs.GraphicFromID(idSbjTrg)
'    Set GrSbd = Grs.GraphicFromID(idSbdTrg)

'    Set TSets = ActDr.TieSets
'    Set TSet = TSets.TieSet(idSbjSrc, idSbdSrc)
'    Set Tie = TSet(0)
'    tieData = Tie.Data

'    TSets.Add idVTie, GrSbj, GrSbd, tieData.idVrtSbj, 0, TSet

'    Set Tie = TSet(0)
'    Tie.Data = tieData

    Clear

    ITurboCADSmartTieServer_CopyTie = True
End Function

Private Function ITurboCADSmartTieServer_DeleteTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, ByVal pIDsipGr As Object) As Boolean
'MsgBox ("DeleteTie" & "  idSbj=" & CStr(idSbj) & "  idSbd=" & CStr(idSbd))
    ITurboCADSmartTieServer_DeleteTie = True
'Exit Function
    Set GrSbj = Nothing
    Set GrSbd = Nothing
    On Error Resume Next
    Set GrSbj = pIDispDwg.Graphics.GraphicFromID(idSbj)
    On Error Resume Next
    Set GrSbd = pIDispDwg.Graphics.GraphicFromID(idSbd)
    If (GrSbj Is Nothing) Or (GrSbd Is Nothing) Then
        'if was deleted Curve or Curve changed ID
        If GrSbj Is Nothing Then
            Set GrSbj = Nothing
            Set GrSbd = Nothing
            Exit Function
        End If
        If GrSbj.Type = "TextAlong.Curve" Then
           If GrSbj.Properties("GrConID") <> -1 Then
'        MsgBox ("DeleteTie Update")
                GrSbj.Update '???????????????????
                Set GrSbj = Nothing
                Set GrSbd = Nothing
            End If
        End If
    Else
    ' if Both object exist
'        MsgBox ("WWWW")
        Set GrSbj = Nothing
        Set GrSbd = Nothing
        Exit Function
    End If
End Function

Private Property Get ITurboCADSmartTieServer_Description() As String
    ITurboCADSmartTieServer_Description = "CurveText_Tie"
End Property

Private Function ITurboCADSmartTieServer_GetIDs(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Variant
' It is not need to do something here because this method doesn't use Graphic's DataBase ID
End Function

Private Function ITurboCADSmartTieServer_GetTypesInfo(Names As Variant, Types As Variant) As Long
    ITurboCADSmartTieServer_GetTypesInfo = 0
End Function

Private Function ITurboCADSmartTieServer_Initialize(ByVal ThisTieMethod As Object) As Boolean
    Dim gxTMethod As TieMethod
    Set gxTMethod = ThisTieMethod
    idVTie = gxTMethod.Name
    ITurboCADSmartTieServer_Initialize = True
End Function

Private Function UpdateTie(ByRef TSet As TieSet, ByRef TSets As TieSets, ByVal idSbj As Long, ByVal idSbd As Long)
'MsgBox ("UpdateTie")
   Dim varData As Variant
    Set Tie = TSet(0)

    varData = Tie.Data
    tieData = varData(0)
Dim xLoc0Text#, yLoc0Text#, AnglePrev#, ConVertex As Long, xLoc0RelText#
Dim fiMidPrev#, xcPrev#, ycPrev#
Dim LFullPrev#, x0Prev#, y0Prev#, x1Prev#, y1Prev#, L0RelPrev#, L1RelPrev#, L2RelPrev#

    ConVertex = tieData.idVertPoly
    AnglePrev = tieData.AnglePrev
    xLoc0RelText = tieData.xLocRelPrev

    fiMidPrev = tieData.fiMidPrev
    xcPrev = tieData.xcPrev
    ycPrev = tieData.ycPrev

    LFullPrev = tieData.LFullPrev     ' for Curve or TCW50Polyline
    x0Prev = tieData.x0Prev     ' for Curve or TCW50Polyline
    y0Prev = tieData.y0Prev     ' for Curve or TCW50Polyline
    x1Prev = tieData.x1Prev     ' for Curve or TCW50Polyline
    y1Prev = tieData.y1Prev     ' for Curve or TCW50Polyline
    L0RelPrev = tieData.L0RelPrev     ' for Curve or TCW50Polyline
    L1RelPrev = tieData.L1RelPrev    ' for Curve or TCW50Polyline
    L2RelPrev = tieData.L2RelPrev    ' for Curve or TCW50Polyline
    Set GrSbj = TSet.Subject
    Set GrSbd = TSet.Subordinate

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'GoTo EEEE
' If exist parent graphic then Exit from update

Dim ParentExist As Boolean
    ParentExist = False
Dim GrPar As Variant
    Set GrPar = Nothing
    On Error Resume Next
    Set GrPar = GrSbj.Parent
    If GrPar Is Nothing Then
        ParentExist = True  ' If Parent is BlockInsertion
        Set GrPar = Nothing
    Else
        If GrPar.Type <> "GRAPHIC" Then
            ParentExist = False ' If Parent is Root
        Else
            ParentExist = True  ' if Parent is Group or Symbol
        End If
        Set GrPar = Nothing
    End If
    If ParentExist = True Then Exit Function
    Set GrPar = Nothing
    On Error Resume Next
    Set GrPar = GrSbd.Parent
    If GrPar Is Nothing Then
        ParentExist = True  ' If Parent is BlockInsertion
        Set GrPar = Nothing
    Else
        If GrPar.Type <> "GRAPHIC" Then
            ParentExist = False ' If Parent is Root
        Else
            ParentExist = True  ' if Parent is Group or Symbol
        End If
        Set GrPar = Nothing
    End If
'MsgBox ("UpdateTie")

'++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    hDr = TCWDrawingActive
'    hGrSbj = TCWGraphicAt(hDr, GrSbj.Index)
    hGrSbj = TCWGraphicHandleFromID(GrSbj.ID)

'    hGrSbd = TCWGraphicAt(hDr, GrSbd.Index)
    hGrSbd = TCWGraphicHandleFromID(GrSbd.ID)

    hMatSbj = GraphicGetMatrix(hGrSbj)
    hMatSbd = GraphicGetMatrix(hGrSbd)

Dim Sel As Selection, Gr1 As Graphic
        Set Sel = GrSbj.Drawing.Selection
Dim SelCount As Long, j As Long
Dim GrSbjSel As Boolean, GrSbdSel As Boolean
        GrSbjSel = False
        GrSbdSel = False
        SelCount = Sel.Count
        For j = 0 To SelCount - 1
            If Sel(j).ID = idSbj Then GrSbjSel = True
            If Sel(j).ID = idSbd Then GrSbdSel = True
        Next j
        Set Sel = Nothing
Dim x0#, y0#, x1#, y1#, x2#, y2#, xc#, yc#, x0Text#, y0Text#
Dim L#, sina#, cosa#
Dim xLoc0TextNew#, AngleNext#
Dim GrConType$

'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
    ' if was edited Regen -Text
    If GrSbj.Type = "TextAlong.Curve" Then
' MsgBox ("Edited text")
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
    ' if were selected both graphics
    If (GrSbjSel = True And GrSbdSel = True) Or (GrSbjSel = False And GrSbdSel = False) Then
        Exit Function
    End If
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

Dim Res As Boolean
        Res = MatrixEqual(hMatSbj, hMatSbd)
        If Res = False Then
            GraphicSetMatrix hGrSbj, hMatSbd
        End If

        GrSbj.Update
'MsgBox ("edited Regen -Text" & " ConVertex=" & CStr(ConVertex))
Dim TSet1 As TieSet, Tie1 As Tie
        Set TSet1 = TSets.TieSet(idSbd, idSbj)
        Set Tie1 = TSet1(0)
        varData = Tie1.Data
        tieData = varData(0)
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        GrConType = GrSbj.Properties("GrConType")

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    ' if connected graphic is Curve or TCW50Polyline
        If GrConType = "GRAPHIC" Or GrConType = "CIRCLE" Or GrConType = "ARC" Or GrConType = "TCW30CURVE" Or GrConType = "TCW50Polyline" Then
Dim GrCosm As Graphic
            If GrConType = "TCW30CURVE" Then
                Set GrCosm = GrSbd.Graphics(1)
            End If
            If GrConType = "TCW50Polyline" Then
Dim ChWithWidth As Boolean
                ChWithWidth = False
                If GrSbd.Graphics.Count > 1 Then
                    ChWithWidth = True
                End If
                If GrSbd.Graphics.Count > 0 Then
                    If (GrSbd.Graphics(0).Name = "Line_Width_Cosmetic" Or GrSbd.Graphics(0).Name = "ChildWithWidth") Then
                        ChWithWidth = True
                    End If
                End If
                If ChWithWidth = True Then Exit Function
                Set GrCosm = Nothing
                On Error Resume Next
                Set GrCosm = GrSbd.Graphics(0)
                If GrCosm Is Nothing Then
                    GrConType = "GRAPHIC"
                End If
            End If
            If (GrConType = "CIRCLE" And GrSbd.Unbounded = False) Or GrConType = "ARC" Then
                Set GrCosm = GrSbd.Duplicate
                If GrSbd.Drawing.Properties("TileMode") = 1 Then
                    On Error Resume Next
                    GrCosm.Properties("Thickness") = 0
                    GrCosm.Update
                End If
                GrCosm.Properties("BrushStyle") = ""
                GrCosm.Update
                GrSbd.Drawing.Graphics.Remove GrCosm.Index
                Set GrCosm = GrCosm.Explode(0)
            End If

Dim nVCosm As Long, i As Long
            If GrSbd.Unbounded = True And GrConType = "CIRCLE" Then
                nVCosm = 50
            Else
                If GrConType = "GRAPHIC" Then
                    nVCosm = GrSbd.Vertices.Count
                Else
                    nVCosm = GrCosm.Vertices.Count
                End If
            End If
Dim CurInfo As CosmInfo
ReDim CurInfo.dL(nVCosm + 5)
ReDim CurInfo.lCur(nVCosm + 5)
ReDim CurInfo.xVer(nVCosm + 5)
ReDim CurInfo.yVer(nVCosm + 5)
ReDim CurInfo.Bet(nVCosm + 5)
            If GrSbd.Unbounded = True And GrConType = "CIRCLE" Then
                Call FormConCircStruct(GrSbd, CurInfo, LFullPrev)
            Else
                If GrConType = "GRAPHIC" Then
                    Call FormCosmStruct(GrSbd, CurInfo, LFullPrev)
                Else
                    Call FormCosmStruct(GrCosm, CurInfo, LFullPrev)
                End If

                If GrConType = "CIRCLE" Or GrConType = "ARC" Then
                    GrCosm.Deleted = True
                End If
            End If

            If GrConType = "CIRCLE" Then
                With GrSbd.Vertices
                    x0Prev = .Item(0).x
                    y0Prev = .Item(0).y
                    x1Prev = .Item(1).x
                    y1Prev = .Item(1).y
                End With
            Else
                x0Prev = CurInfo.xVer(0)
                y0Prev = CurInfo.yVer(0)
                x1Prev = CurInfo.xVer(1)
                y1Prev = CurInfo.yVer(1)
            End If

        ' Define parameters for TextAlongCurve
            With GrSbj.Vertices
                x0 = .Item(0).x
                y0 = .Item(0).y
                x1 = .Item(1).x
                y1 = .Item(1).y
                x2 = .Item(2).x
                y2 = .Item(2).y
            End With
Dim L0#, L1#, L2#
Dim iMin As Long, xLocMin#
            Call NumSegmByXY(CurInfo, x0, y0, iMin, L0, xLocMin)
            Call NumSegmByXY(CurInfo, x1, y1, iMin, L1, xLocMin)
            Call NumSegmByXY(CurInfo, x2, y2, iMin, L2, xLocMin)
            L0RelPrev = L0 / LFullPrev
            L1RelPrev = L1 / LFullPrev
            L2RelPrev = L2 / LFullPrev
'MsgBox ("Edit Text L0Rel=" & CStr(L0RelPrev) & "  L1Rel=" & CStr(L1RelPrev) & "  L2Rel=" & CStr(L2RelPrev))

            tieData.L0RelPrev = L0RelPrev
            tieData.L1RelPrev = L1RelPrev
            tieData.L2RelPrev = L2RelPrev
            Tie1.Data = tieData
            Tie.Data = tieData
            Set GrCosm = Nothing
        End If
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
        Set Tie1 = Nothing
        Set TSet1 = Nothing
        Exit Function
    End If
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
'&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&

'    GrSbd.Visible = False
'   GrSbd.Draw

'######################################################################
'######################################################################

  ' if was edited Curve
' MsgBox ("Edited Curve")

    GrConType = GrSbd.Properties("GrConType")
    If GrConType <> "GRAPHIC" Then
        If GrConType <> "TCW50Polyline" Then
            GrSbj.Update
        End If
    End If
Dim CurGrConType$
    CurGrConType = GrSbj.Type
    If GrConType = "GRAPHIC" Then
        If CurGrConType = "TCW50IntProp" Then GoTo CUR
        If CurGrConType = "TCW50Polyline" Then
            nVCosm = GrSbj.Graphics(0).Vertices.Count
            If nVCosm = GrSbj.Vertices.Count Then
                GoTo CUR 'Regime NodeEdit
            Else
                GrConType = "TCW50Polyline"
                GrSbd.Properties("GrConType") = "TCW50Polyline"
            End If
        End If
CUR:
    End If

    Res = MatrixEqual(hMatSbj, hMatSbd)
    If Res = False Then
        GraphicSetMatrix hGrSbd, hMatSbj
    End If
'Begin the old Center graphic
Dim GrCent As Graphic
Dim GrCount As Long
    GrCount = GrSbd.Graphics.Count
    For i = 0 To GrCount - 1
        Set GrCent = GrSbd.Graphics(i)
        If GrCent.Type = "GRAPHIC" And GrCent.Cosmetic = False Then
            If GrCent.Vertices.Count = 3 Then
                Exit For
            End If
        End If
    Next i
'End the old Center graphic

'######################################################################
' if was edited Curve or TCW50Polyline
    If GrConType = "GRAPHIC" Or GrConType = "CIRCLE" Or GrConType = "ARC" Or GrConType = "TCW30CURVE" Or GrConType = "TCW50Polyline" Then
'MsgBox ("Update Tie   " & GrConType)
        If GrConType = "TCW30CURVE" Then
            Set GrCosm = GrSbj.Graphics(1)
        End If
        If GrConType = "TCW50Polyline" Then
            ChWithWidth = False
'            If GrSbj.Graphics.Count > 1 Then
'                ChWithWidth = True
'            End If
            If GrSbj.Graphics.Count > 0 Then
                If GrSbj.Graphics(0).Name = "Line_Width_Cosmetic" Or GrSbj.Graphics(0).Name = "ChildWithWidths" Then
                    ChWithWidth = True
                End If
            End If
'            MsgBox (GrConType & "   " & CStr(ChWithWidth))
            If ChWithWidth = True Then Exit Function
            On Error Resume Next
            Set GrCosm = GrSbj.Graphics(0)
            If GrCosm Is Nothing Then
'MsgBox ("Nothing")
                GrConType = "GRAPHIC"
                If GrConType = "GRAPHIC" Then
                    GrSbd.Properties("GrConType") = "GRAPHIC"
                End If
            Else
                nVCosm = GrCosm.Vertices.Count
'MsgBox ("nVCosm=" & CStr(nVCosm))
                If nVCosm < 2 Then
                    GrConType = "GRAPHIC"
                End If
                If GrConType = "GRAPHIC" Then
                    GrSbd.Properties("GrConType") = "GRAPHIC"
                End If
            End If
        End If

        If (GrConType = "CIRCLE" And GrSbj.Unbounded = False) Or GrConType = "ARC" Then
            Set GrCosm = GrSbj.Duplicate
            If GrSbj.Drawing.Properties("TileMode") = 1 Then
                GrCosm.Properties("Thickness") = 0
                GrCosm.Update
            End If
            GrCosm.Properties("BrushStyle") = ""
            GrCosm.Update
            GrSbj.Drawing.Graphics.Remove GrCosm.Index
            Set GrCosm = GrCosm.Explode(0)
        End If

Dim dL#, LFullNew#, x0New#, y0New#, x1New#, y1New#
        If GrSbj.Unbounded = True And GrConType = "CIRCLE" Then
            nVCosm = 50
        Else
            If GrConType = "GRAPHIC" Then
                nVCosm = GrSbj.Vertices.Count
            Else
                nVCosm = GrCosm.Vertices.Count
            End If
        End If
'MsgBox (GrConType & " nvCosm=" & CStr(nVCosm))

ReDim CurInfo.dL(nVCosm + 5)
ReDim CurInfo.lCur(nVCosm + 5)
ReDim CurInfo.xVer(nVCosm + 5)
ReDim CurInfo.yVer(nVCosm + 5)
ReDim CurInfo.Bet(nVCosm + 5)
        If GrSbj.Unbounded = True And GrConType = "CIRCLE" Then
            Call FormConCircStruct(GrSbj, CurInfo, LFullNew)
        Else
            If GrConType = "GRAPHIC" Then
                Call FormCosmStruct(GrSbj, CurInfo, LFullNew)
            Else
                Call FormCosmStruct(GrCosm, CurInfo, LFullNew)
            End If
            If GrConType = "CIRCLE" Or GrConType = "ARC" Then
                GrCosm.Deleted = True
            End If
        End If

        If GrConType = "CIRCLE" Then
            With GrSbj.Vertices
                x0New = .Item(0).x
                y0New = .Item(0).y
                x1New = .Item(1).x
                y1New = .Item(1).y
            End With
        Else
            x0New = CurInfo.xVer(0)
            y0New = CurInfo.yVer(0)
            x1New = CurInfo.xVer(1)
            y1New = CurInfo.yVer(1)
        End If

        Set GrCosm = Nothing

        L = Sqr((x1Prev - x0Prev) * (x1Prev - x0Prev) + (y1Prev - y0Prev) * (y1Prev - y0Prev))
        sina = (y1Prev - y0Prev) / L
        cosa = (x1Prev - x0Prev) / L
        AnglePrev = Angle(sina, cosa)

        L = Sqr((x1New - x0New) * (x1New - x0New) + (y1New - y0New) * (y1New - y0New))
        sina = (y1New - y0New) / L
        cosa = (x1New - x0New) / L
        AngleNext = Angle(sina, cosa)

        If Abs(LFullNew - LFullPrev) < 0.0001 * LFullPrev Then
            ' Was moved Whole Graphic Curve or TCW50Polyline

'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
            If GrSbjSel = True And GrSbdSel = True Then
                GoTo WWW
            End If
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@

            If GrSbjSel = True And GrSbdSel = False Then
                Call TextRotAndMoved(GrSbd, GrCent, AngleNext - AnglePrev, x0New - x0Prev, y0New - y0Prev, x0Prev, y0Prev)
            End If
        Else
WWW:
            ' Was edited some vertices of Graphic Curve or TCW50Polyline

'MsgBox ("LFullPrev=" & CStr(LFullPrev) & "  LFullNew=" & CStr(LFullNew))
Dim LText#
            L0 = L0RelPrev * LFullNew
            L1 = L1RelPrev * LFullNew
            L2 = L2RelPrev * LFullNew
            Call XYFromL(CurInfo, LFullNew, L0, x0, y0)
            Call XYFromL(CurInfo, LFullNew, L1, x1, y1)
            Call XYFromL(CurInfo, LFullNew, L2, x2, y2)
'MsgBox ("x0=" & CStr(x0) & " y0=" & CStr(y0) & "  x1=" & CStr(x1) & " y1=" & CStr(y1) & "  x2=" & CStr(x2) & " y2=" & CStr(y2))

Dim LCentCosm#, xCentCosm#, yCentCosm#
            LCentCosm = 1.001 * L0 ' for initiate working regen in moved center point of text regime
            Call XYFromL(CurInfo, LFullNew, LCentCosm, xCentCosm, yCentCosm)

            With GrSbd.Vertices
                .Item(0).x = x0
                .Item(0).y = y0
                .Item(1).x = x1
                .Item(1).y = y1
                .Item(2).x = x2
                .Item(2).y = y2
            End With
'MsgBox ("x1=" & CStr(x1) & " y1=" & CStr(y1) & "  x2=" & CStr(x2) & " y2=" & CStr(y2))
            With GrCent.Vertices
                .Item(0).x = xCentCosm
                .Item(0).y = yCentCosm
                .Item(1).x = x1
                .Item(1).y = y1
                .Item(2).x = x2
                .Item(2).y = y2
            End With
            Set GrCosm = Nothing
            Set GrCent = Nothing
        End If
        tieData.LFullPrev = LFullNew
        tieData.x0Prev = x0New
        tieData.y0Prev = y0New
        tieData.x1Prev = x1New
        tieData.y1Prev = y1New
        GrSbd.Update
        GrSbd.Draw

    End If
'######################################################################
'######################################################################

'    GrSbd.Update
'    GrSbd.Visible = True
'    GrSbd.Draw

    varData = tieData
    Tie.Data = tieData

End Function

Private Sub ITurboCADSmartTieServer_SetIDs(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long, pvarIDs As Variant)
' It is not need to do something here because this method doesn't use Graphic's DataBase ID
End Sub

Private Function ITurboCADSmartTieServer_TieCanNODEED(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Boolean
'MsgBox ("TieCanNODEED")
    ITurboCADSmartTieServer_TieCanNODEED = True
End Function

Private Function ITurboCADSmartTieServer_UpdateTie(ByVal pIDispDwg As Object, ByVal idSbj As Long, ByVal idSbd As Long) As Integer
'MsgBox ("UpdateTies")
    Set ActDr = pIDispDwg
    Set GrSbj = Nothing
    Set GrSbd = Nothing
    On Error Resume Next
    Set GrSbj = ActDr.Graphics.GraphicFromID(idSbj)
    On Error Resume Next
    Set GrSbd = ActDr.Graphics.GraphicFromID(idSbd)
    If GrSbj Is Nothing Then
        ITurboCADSmartTieServer_UpdateTie = 0
        Set GrSbj = Nothing
        Set GrSbd = Nothing
        Set ActDr = Nothing
        Clear
        Exit Function
    End If
    If GrSbd Is Nothing Then
        ITurboCADSmartTieServer_UpdateTie = 0
        Set GrSbj = Nothing
        Set GrSbd = Nothing
        Set ActDr = Nothing
        Clear
        Exit Function
    End If

    Set ActDr = pIDispDwg

    Set TSets = ActDr.TieSets
    Set TSet = TSets.TieSet(idSbj, idSbd)

    UpdateTie TSet, TSets, idSbj, idSbd

    ITurboCADSmartTieServer_UpdateTie = 0
    Set GrSbj = Nothing
    Set GrSbd = Nothing
    Set ActDr = Nothing
    Clear

End Function

Private Function Angle(sinb As Double, cosb As Double) As Double

        If Abs(cosb) < 0.0001 Then
            If sinb > 0 Then
                Angle = Pi / 2
            Else
                Angle = 3 * Pi / 2
            End If
        Else
            If sinb >= 0 And cosb > 0 Then Angle = Atn(sinb / cosb)
            If sinb >= 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb < 0 Then Angle = Pi + Atn(sinb / cosb)
            If sinb < 0 And cosb > 0 Then Angle = 2 * Pi + Atn(sinb / cosb)
        End If
End Function

'#######################################################################
'#######################################################################
'#######################################################################
'#######################################################################

' Write the Data about cosmetic into Structure for Curve and TCW50olyline
Private Sub FormCosmStruct(Gr As Graphic, CurInfo As CosmInfo, LFull As Double)
Dim CurveClosed As Boolean
        If Gr.Closed = True Then
            CurveClosed = True
        Else
            CurveClosed = False
        End If
Dim nV As Long, i As Long, j As Long
        nV = Gr.Vertices.Count
Dim L#, xi#, yi#, xi1#, yi1#, dL#, sina#, cosa#, Bet#
        If CurveClosed = True Then
            CurInfo.nV = nV
            L = 0
            CurInfo.lCur(0) = L
            With Gr.Vertices
                For i = 0 To nV - 2
                    xi = .Item(i).x
                    yi = .Item(i).y
                    xi1 = .Item(i + 1).x
                    yi1 = .Item(i + 1).y
                    dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                    If dL < Eps Then
                        dL = 0
                        Bet = 0
                    Else
                        sina = (yi1 - yi) / dL
                        cosa = (xi1 - xi) / dL
                        Bet = Angle(sina, cosa)
                    End If
                    L = L + dL
                    CurInfo.xVer(i) = xi
                    CurInfo.yVer(i) = yi
                    CurInfo.lCur(i + 1) = L
                    CurInfo.dL(i) = dL
                    CurInfo.Bet(i) = Bet
                Next i
                CurInfo.xVer(nV - 1) = xi1
                CurInfo.yVer(nV - 1) = yi1
            End With
        Else
            CurInfo.nV = nV + 2
Dim k As Long
            k = 0
Dim xPrev#, yPrev#, xLast#, yLast#, LAdd#
            LAdd = 10
            L = 0

            CurInfo.lCur(0) = L
            With Gr.Vertices
                'First added segment
                xi = .Item(0).x
                yi = .Item(0).y
                xi1 = .Item(1).x
                yi1 = .Item(1).y
                dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                If dL < Eps Then
                    For j = 1 To nV - 1
                        xi1 = .Item(j).x
                        yi1 = .Item(j).y
                        dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                        If dL > Eps Then Exit For
                    Next j
                End If
                xPrev = xi1 + (xi - xi1) * (LAdd + dL) / dL
                yPrev = yi1 + (yi - yi1) * (LAdd + dL) / dL
                xi1 = xi
                yi1 = yi
                xi = xPrev
                yi = yPrev
                dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                sina = (yi1 - yi) / dL
                cosa = (xi1 - xi) / dL
                Bet = Angle(sina, cosa)
                L = L + dL
                CurInfo.xVer(k) = xi
                CurInfo.yVer(k) = yi
                CurInfo.lCur(k + 1) = L
                CurInfo.dL(k) = dL
                CurInfo.Bet(k) = Bet
                k = k + 1

                 'Base cosmetic segments
                For i = 0 To nV - 2
                    xi = .Item(i).x
                    yi = .Item(i).y
                    xi1 = .Item(i + 1).x
                    yi1 = .Item(i + 1).y
                    dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                    If dL < Eps Then
                        dL = 0
                        Bet = 0
                    Else
                        sina = (yi1 - yi) / dL
                        cosa = (xi1 - xi) / dL
                        Bet = Angle(sina, cosa)
                    End If
                    L = L + dL
                    CurInfo.xVer(k) = xi
                    CurInfo.yVer(k) = yi
                    CurInfo.lCur(k + 1) = L
                    CurInfo.dL(k) = dL
                    CurInfo.Bet(k) = Bet
                    k = k + 1
                Next i
                'Last added segment
                xi = .Item(nV - 2).x
                yi = .Item(nV - 2).y
                xi1 = .Item(nV - 1).x
                yi1 = .Item(nV - 1).y
                dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                If dL < Eps Then
                    For j = nV - 3 To 0 Step -1
                        xi = .Item(j).x
                        yi = .Item(j).y
                        dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                        If dL > Eps Then Exit For
                    Next j
                End If
                xLast = xi + (xi1 - xi) * (LAdd + dL) / dL
                yLast = yi + (yi1 - yi) * (LAdd + dL) / dL
                xi = xi1
                yi = yi1
                xi1 = xLast
                yi1 = yLast
                dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
                sina = (yi1 - yi) / dL
                cosa = (xi1 - xi) / dL
                Bet = Angle(sina, cosa)
                L = L + dL
                CurInfo.xVer(k) = xi
                CurInfo.yVer(k) = yi
                CurInfo.lCur(k + 1) = L
                CurInfo.dL(k) = dL
                CurInfo.Bet(k) = Bet
                k = k + 1
                CurInfo.xVer(k) = xi1
                CurInfo.yVer(k) = yi1
            End With
            ' Edit Content of CurInfo Structure for nonclosed curve
            Call EditCurInfoNonClosed(CurInfo, L)
        End If
        LFull = L

End Sub

' Edit Content of CurInfo Structure for nonclosed curve

Private Sub EditCurInfoNonClosed(CurInfo As CosmInfo, L As Double)
Dim nV As Long, i As Long
Dim LClear#
    LClear = L - 20
    nV = CurInfo.nV
Dim xi#, yi#, xi1#, yi1#
    ' First line segment
    xi = CurInfo.xVer(1)
    yi = CurInfo.yVer(1)
    xi1 = CurInfo.xVer(0)
    yi1 = CurInfo.yVer(0)

    xi1 = xi + (xi1 - xi) * LClear / 10
    yi1 = yi + (yi1 - yi) * LClear / 10
    CurInfo.xVer(0) = xi1
    CurInfo.yVer(0) = yi1
    CurInfo.lCur(1) = LClear
    CurInfo.dL(0) = LClear

    ' Middle segments
Dim dL#, LTem#
    LTem = LClear
    For i = 2 To nV - 2
        dL = CurInfo.dL(i - 1)
        LTem = LTem + dL
        CurInfo.lCur(i) = LTem
    Next i

    ' End line segment
    xi = CurInfo.xVer(nV - 2)
    yi = CurInfo.yVer(nV - 2)
    xi1 = CurInfo.xVer(nV - 1)
    yi1 = CurInfo.yVer(nV - 1)

    xi1 = xi + (xi1 - xi) * LClear / 10
    yi1 = yi + (yi1 - yi) * LClear / 10
    CurInfo.xVer(nV - 1) = xi1
    CurInfo.yVer(nV - 1) = yi1
    CurInfo.lCur(nV - 1) = LTem + LClear
    CurInfo.dL(nV - 2) = LClear

    L = LTem + LClear
End Sub

' define the number of segment by X-Y coordinate of the point
' Return values iMin - Number of segment,
'                Li -Lenght from begining Curve
'                xlocMin - local coordinate on segment

Private Sub NumSegmByXY(CurInfo As CosmInfo, x As Double, y As Double, iMin As Long, Li As Double, xLocMin As Double)
Dim nV As Long, i As Long
Dim xi#, yi#, xi1#, yi1#, Bet#, sina#, cosa#, dL#
Dim xLoc#, yLoc#
Dim yLocMin#

    yLocMin = 1000000
    nV = CurInfo.nV
    For i = 0 To nV - 2
        xi = CurInfo.xVer(i)
        yi = CurInfo.yVer(i)
        xi1 = CurInfo.xVer(i + 1)
        yi1 = CurInfo.yVer(i + 1)
        dL = CurInfo.dL(i)
        Bet = CurInfo.Bet(i)
        sina = Sin(Bet)
        cosa = Cos(Bet)
        yLoc = (y - yi) * cosa - (x - xi) * sina
        xLoc = (y - yi) * sina + (x - xi) * cosa
'MsgBox ("i=" & CStr(i) & "  xi=" & CStr(xi) & " yi=" & CStr(yi) & "  xi1=" & CStr(xi1) & " yi1=" & CStr(yi1) & " dL=" & CStr(dL) & " Bet=" & CStr(Bet * 180 / Pi))
'MsgBox ("xLoc=" & CStr(xLoc) & " yLoc=" & CStr(yLoc))
        If Abs(yLoc) < yLocMin And xLoc > -Eps And xLoc < dL + Eps Then
            yLocMin = Abs(yLoc)
            iMin = i
'            If iMin = 0 Then
'                Li = xLoc
'            Else
                Li = CurInfo.lCur(i) + xLoc
'            End If
            xLocMin = xLoc
        End If
    Next i

End Sub

' define the number of segment by l - lenght from begining of curve
Private Sub NumSegmByL(CurInfo As CosmInfo, L As Double, iMin As Long, xLocMin As Double)
Dim nV As Long, i As Long, Li As Double, Li1 As Double
    nV = CurInfo.nV
    For i = 0 To nV - 2
        Li = CurInfo.lCur(i)
        Li1 = CurInfo.lCur(i + 1)
'MsgBox ("!!!! i=" & CStr(i) & " li=" & CStr(Li) & " li1=" & CStr(Li1))
        If L > Li + Eps And L < Li1 + Eps Then
            iMin = i
            xLocMin = L - Li
            Exit For
        End If
    Next i
End Sub

' define coordinate X,Y From Li for Curve
Private Sub XYFromL(CurInfo As CosmInfo, LFull As Double, Li As Double, x As Double, y As Double)
Dim LTem#, iSegi As Long, xLoci#, yLoci#, xi#, yi#, Bet#
        LTem = Li
        If Li > LFull Then LTem = Li - LFull
        If Li < 0 Then LTem = LFull + Li
        Call NumSegmByL(CurInfo, LTem, iSegi, xLoci)
        Bet = CurInfo.Bet(iSegi)
        xi = CurInfo.xVer(iSegi)
        yi = CurInfo.yVer(iSegi)
        yLoci = 0
        x = xi + xLoci * Cos(Bet) - yLoci * Sin(Bet)
        y = yi + xLoci * Sin(Bet) + yLoci * Cos(Bet)
End Sub

' Rotate and move Base vertices of GrText
Private Sub TextRotAndMoved(Gr As Graphic, GrCent As Graphic, dfi As Double, dx As Double, dy As Double, xRef As Double, yRef As Double)
Dim x0#, y0#, x1#, y1#, x2#, y2#
    With Gr.Vertices
        x0 = .Item(0).x
        y0 = .Item(0).y
        x1 = .Item(1).x
        y1 = .Item(1).y
        x2 = .Item(2).x
        y2 = .Item(2).y
    End With

Dim ri#, fi#, sina#, cosa#
    If Abs(x0 - xRef) > Eps Or Abs(y0 - yRef) > Eps Then
        ri = Sqr((x0 - xRef) * (x0 - xRef) + (y0 - yRef) * (y0 - yRef))
        sina = (y0 - yRef) / ri
        cosa = (x0 - xRef) / ri
        fi = Angle(sina, cosa)
        x0 = xRef + ri * Cos(fi + dfi)
        y0 = yRef + ri * Sin(fi + dfi)
    End If

    ri = Sqr((x1 - xRef) * (x1 - xRef) + (y1 - yRef) * (y1 - yRef))
    sina = (y1 - yRef) / ri
    cosa = (x1 - xRef) / ri
    fi = Angle(sina, cosa)
    x1 = xRef + ri * Cos(fi + dfi)
    y1 = yRef + ri * Sin(fi + dfi)

    ri = Sqr((x2 - xRef) * (x2 - xRef) + (y2 - yRef) * (y2 - yRef))
    sina = (y2 - yRef) / ri
    cosa = (x2 - xRef) / ri
    fi = Angle(sina, cosa)
    x2 = xRef + ri * Cos(fi + dfi)
    y2 = yRef + ri * Sin(fi + dfi)

    x0 = x0 + dx
    y0 = y0 + dy
    x1 = x1 + dx
    y1 = y1 + dy
    x2 = x2 + dx
    y2 = y2 + dy

    With Gr.Vertices
        .Item(0).x = x0
        .Item(0).y = y0
        .Item(1).x = x1
        .Item(1).y = y1
        .Item(2).x = x2
        .Item(2).y = y2
    End With
    With GrCent.Vertices
        .Item(0).x = x0 + 0.001
        .Item(0).y = y0
        .Item(1).x = x1
        .Item(1).y = y1
        .Item(2).x = x2
        .Item(2).y = y2
    End With

End Sub

' Write the Data about CONSTRUCTION CIRCLE into Structure for Graphic and Curve and TCW50olyline

Private Sub FormConCircStruct(GrCirc As Graphic, CurInfo As CosmInfo, LFull As Double)

Dim xi#, yi#, xi1#, yi1#, L#, dL#, sina#, cosa#, Bet#
Dim xc#, yc#, x1#, y1#
    With GrCirc.Vertices
        xc = .Item(0).x
        yc = .Item(0).y
        x1 = .Item(1).x
        y1 = .Item(1).y
    End With
Dim nV As Long, i As Long
    nV = 41
Dim R#, dfi#
    R = Sqr((x1 - xc) * (x1 - xc) + (y1 - yc) * (y1 - yc))
    LFull = 2 * Pi * R
    dfi = 2 * Pi / (nV - 1)

    CurInfo.nV = nV
    L = 0
    CurInfo.lCur(0) = L
    For i = 0 To nV - 2
        xi = xc + R * Cos(dfi * i)
        yi = yc + R * Sin(dfi * i)
        xi1 = xc + R * Cos(dfi * (i + 1))
        yi1 = yc + R * Sin(dfi * (i + 1))
        dL = Sqr((xi1 - xi) * (xi1 - xi) + (yi1 - yi) * (yi1 - yi))
        sina = (yi1 - yi) / dL
        cosa = (xi1 - xi) / dL
        Bet = Angle(sina, cosa)
        L = L + dL
        CurInfo.xVer(i) = xi
        CurInfo.yVer(i) = yi
        CurInfo.lCur(i + 1) = L
        CurInfo.dL(i) = dL
        CurInfo.Bet(i) = Bet
    Next i
    CurInfo.xVer(nV - 1) = xi1
    CurInfo.yVer(nV - 1) = yi1

End Sub


Examples - SDK Regen Tool - clsToolReg.cls

clsToolReg.cls

SDK Regen Tool Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Regens"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'Number of tools in this server
Const NUM_TOOLS = 1
Const gkGraphic = 11
Const gkGroup = 7
'Toggle this to test loading buttons from .Bmp/.Res
'Const boolLoadFromBmp As Boolean = False
Const boolDebug As Boolean = False

'Return a description string for this package of tools
Public Property Get Description() As String
    Description = "Regen Method tool"
End Property

'Called to perform tool function
Public Function Run(ByVal Tool As Object) As Boolean
    Dim objApp As Object
    Dim Drs As Object
    Dim ActDr As Object
    Dim Gr As Object

    'Look for first URL property in the selection
    Set objApp = Tool.Application
    Set ActDr = objApp.ActiveDrawing
    Set Grs = ActDr.Graphics
    Dim RegMets As Object
    Dim Count As Long
    Count = Tool.Application.RegenMethods.Count
    Dim i As Integer, k%
    k = 0
    Dim Str1$, Str2$, Str3
    For i = 0 To Count - 1
    Str2 = ""
On Error Resume Next

       Str3 = Tool.Application.RegenMethods.Item(i).Type
       If Str3 = imsiAutomation Then
            Str2 = Tool.Application.RegenMethods.Item(i).Description

                    Str1 = Tool.Application.RegenMethods.Item(i).Name
            If Str1 = "HatchWizard.HatchWizard.1" Then
                GoTo RR
            ElseIf Str1 = "Smart.Connection.1" Then
                GoTo RR
            ElseIf Str1 = "Viewport.DimensionConnection.1" Then
                GoTo RR
            ElseIf Str1 = "Foundation.House" Then
                GoTo RR
            ElseIf Str1 = "AutoDim.House" Then
                GoTo RR
            ElseIf Str1 = "Schedule.Block" Then
                GoTo RR
            ElseIf Str1 = "TextAlong.Curve" Then
            Else

                    frmToolReg.List1.List(k) = Str1
                    frmToolReg.List1.ItemData(k) = i
                    k = k + 1
            End If

        End If
RR:
    Next i
'    For i = 0 To Count - 1
'    Str2 = ""
'On Error Resume Next
'       Str2 = Tool.Application.RegenMethods.Item(i).Description
'       If Mid(Str2, 1, 3) = "SDK" Then
'            Str1 = Tool.Application.RegenMethods.Item(i).Name
'            frmToolReg.List1.List(k) = Str1
'            frmToolReg.List1.ItemData(k) = i
'            k = k + 1
'       End If
'RR:
'    Next i
    frmToolReg.List1.Selected(0) = True
    frmToolReg.Show 1

    Run = True
End Function

'Fill arrays with information about tools in the package
'Return the number of tools in the package
Public Function GetToolInfo(CommandNames As Variant, MenuCaptions As Variant, StatusPrompts As Variant, _
    ToolTips As Variant, Enabled As Variant, WantsUpdates As Variant) As Long
    ReDim CommandNames(NUM_TOOLS)
    ReDim MenuCaptions(NUM_TOOLS)
    ReDim StatusPrompts(NUM_TOOLS)
    ReDim ToolTips(NUM_TOOLS)
    ReDim Enabled(NUM_TOOLS)
    ReDim WantsUpdates(NUM_TOOLS)
    CommandNames(0) = "S&DK|Regens"  '"SDK|Internet|Hyperlink"
    MenuCaptions(0) = "&SDKRegens"
    StatusPrompts(0) = ""
    ToolTips(0) = "SDKRegens"
    Enabled(0) = True
    WantsUpdates(0) = False
    GetToolInfo = NUM_TOOLS
End Function

'Returns true if tool is correctly initialized
Public Function Initialize(ByVal Tool As Object) As Boolean
    Initialize = True
End Function

'Returns true if tool is correctly initialized
Public Function UpdateToolStatus(ByVal Tool As Object, Enabled As Boolean, Checked As Boolean) As Boolean
    Enabled = True 'Could do a test here to determine whether to disable the button/menu item
    Checked = False  'Could do a test here to determine whether to check the button/menu item
    UpdateToolStatus = True
End Function


Examples - SDK Regen Tool - frmToolReg.frm

frmToolReg.frm

SDK Regen Tool Example

VERSION 5.00
Begin VB.Form frmToolReg
   BorderStyle     =   1  'Fixed Single
   Caption         =   " External Objects"
   ClientHeight    =   3105
   ClientLeft      =   2370
   ClientTop       =   3705
   ClientWidth     =   3030
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3105
   ScaleWidth      =   3030
   Begin VB.CommandButton CmdOk
      Caption         =   "Ok"
      Height          =   372
      Left            =   840
      TabIndex        =   1
      Top             =   2520
      Width           =   1212
   End
   Begin VB.ListBox List1
      Height          =   1815
      Left            =   240
      TabIndex        =   0
      Top             =   360
      Width           =   2415
   End
End
Attribute VB_Name = "frmToolReg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const gkGroup = 7
Private Num As Long

Private Sub CmdOk_Click()
    Dim Gr As Object
        If frmToolReg.List1.Text = "Gear.Bearing" Then
            Set Gr = Grs.Add(gkGroup, Num)
        Else
            Set Gr = Grs.Add(gkGraphic, Num)
        End If
        Gr.Draw
End Sub

Private Sub List1_Click()
    Dim Gr As Object
    Dim Str1$
    Str1 = frmToolReg.List1.Text
    Num = frmToolReg.List1.ItemData(frmToolReg.List1.ListIndex)
    Num = Num + 1
End Sub

Private Sub List1_KeyPress(KeyAscii As Integer)
    Dim Num As Long
    Dim Str1$
    If KeyAscii = 13 And List1.ListIndex >= 0 Then
        Str1 = frmToolReg.List1.Text
        Num = frmToolReg.List1.ItemData(frmToolReg.List1.ListIndex)
        Num = Num + 1
    End If
    If KeyAscii = 27 Then
        Me.Hide
    End If
End Sub


Examples - SDK Regen Tool - modToolReg.bas

modToolReg.bas

SDK Regen Tool Example

Attribute VB_Name = "modToolReg"
Option Explicit
Global Grs As Object
Global Const gkGraphic = 11

Sub Main()

End Sub


Examples - Application Environment Macro - modAppEnv.bas

modAppEnv.bas

Application Environment Macro Example

Attribute VB_Name = "modAppEnv"
Option Explicit

Public Sub AppEnvRegenMethodEx1()
    Dim rm As RegenMethod
    For Each rm In Application.RegenMethods
        Debug.Print "RegenMethod: " & rm.Name
    Next
End Sub

Public Sub AppEnvFilterEx1()
    Dim flt As Filter
    For Each flt In Application.Filters
      Debug.Print "Filter: " & flt.Name & ", " & flt.Extension & ", " & flt.Description
    Next
End Sub

Public Sub AppEnvToolEx1()
    Dim t As Tool
    For Each t In Application.Tools
        Debug.Print "Tool: " & t.CommandName
    Next
End Sub

Public Sub AppEnvMacroEx1()
    Dim mac As Macro
    For Each mac In ActiveDrawing.Macros
        Debug.Print "VBA Project: " & mac.Name & ", contained in " & mac.Path
    Next
End Sub


Examples - Basic Analysis Macro - modGeom.bas

modGeom.bas

Basic Analysis Macro Example

Option Explicit

Sub BasicGeometryAnalysis()

'This sample shows how to analyze geometry of various objects in
'a TurboCAD drawing. Of course it is a very simple example – you
'can write more sophisticated routines to analyze complex objects,
'to pass this data to other applications or store data in a database, etc.

'The code in this macro sets reference to the active TurboCAD drawing,
'then creates and displays two objects: a circle and an ellipse
'(AddCircleCenterAndPoint and AddEllipse methods of the Grapghics object),
'and waits for user mouse click to determine the type of the object
'user clicked on (GetMouseClick method of the View object) and
'calculate the object's area. If a click occurs on blank area,
'the procedure exist displaying a warning message. If user clicks
'on a circular object, the procedure displays a message box
'containing the object's type and area.

'Declare variables to hold TurboCAD objects
  Dim ActDr As Drawing
  Dim Grs As Graphics
  Dim Gr As Graphic
  Dim Vi As View
  Dim GrType As String

'Assign PI constant
  Const Pi# = 3.14159

'Get reference to active drawing, its graphics collection,
'and active view
    Set ActDr = ActiveDrawing
    Set Grs = ActDr.Graphics
    Set Vi = ActDr.Views(0)

'Draw circle
    Set Gr = Grs.AddCircleCenterAndPoint(5, 5, 0, 7, 5, 0)
'and use Draw method of Graphic object to display the object
    Gr.Draw

'Draw ellipse
    Set Gr = Grs.AddEllipse(7, 7, 0, 10, 9, 0)
'and use Draw method of Graphic object to display the object
    Gr.Draw

'Declare PickResult collection to hold graphics located
'at the point of mouse click
Dim PRes As PickResult

'Declare variables to hold mouse pointer coordinates
'and graphic items at the point of mouse click
Dim xClick#, yClick#
Dim PicCount As Long

'We ignore object-specific errors in this sample
  On Error Resume Next
'Get mouse click coordinates
    Vi.GetMouseClick xClick, yClick
    Set PRes = Vi.PickPoint(xClick, yClick)

'Get number of items inside PicResult collection
    PicCount = PRes.Count

'Check if any object is selected and exit if not
    If PicCount = 0 Then
        MsgBox "No object selected!", vbExclamation
        Exit Sub
    End If

'Get first graphic item in the collection
    Set Gr = PRes(0).Graphic

'Check if the graphic type is Circle or Arc
    If Gr.Type = "CIRCLE" Or GrType = "ARC" Then

'Declare AcrData array to hold the graphic (Circle, Arc) geometry paramerters
      Dim ArcData(10) As Double
          Gr.GetArcData ArcData

'Get the graphics center point coordinates
      Dim xc#, yc#
          xc = ArcData(0)
          yc = ArcData(1)
'Get ratio
      Dim Ratio#
          Ratio = ArcData(6)

'Determine if it's a closed graphic
      Dim Closed%
          Closed = ArcData(9)

'Determine circular object type
      Dim CircleType$
          If Ratio = 1 And Closed = 1 Then CircleType = "Circle"
          If Ratio <> 1 And Closed = 1 Then CircleType = "Ellipse"
          If Ratio = 1 And Closed = 0 Then CircleType = "ArcCircle"
          If Ratio <> 1 And Closed = 0 Then CircleType = "ArcEllipse"

'Determine main axis' coordinates
      Dim xMajor#, yMajor#
          xMajor = ArcData(3)
          yMajor = ArcData(4)

'Calculate major and minor axes
      Dim a#, b#
          a = Sqr((xMajor - xc) * (xMajor - xc) + (yMajor - yc) * (yMajor - yc))
          b = Ratio * a

'Calculate object's area and display a message with results
      Dim Area#
          Area = 0
          If CircleType = "Circle" Then
              Area = Pi * a * a
              MsgBox "This is a circle. It's area is " & Round(Area, 2) & _
              " sq. inches", vbInformation
          End If
          If CircleType = "Ellipse" Then
              Area = Pi * a * b
              MsgBox "This is an ellipse . It's area is " & Round(Area, 2) & _
              " sq. inches", vbInformation
          End If
    Else
      MsgBox "This is not a circular object or object isn't closed!", vbExclamation
    End If

'Destroy objects
  Set ActDr = Nothing
  Set Grs = Nothing
  Set Vi = Nothing
  Set Gr = Nothing
  Set PRes = Nothing

End Sub


Examples - Blocks Macro - modBlocks.bas

modBlocks.bas

Blocks Macro Example

Attribute VB_Name = "modBlocks"
Option Explicit

Public Function GroupFromSelection() As Graphic
    On Error GoTo GroupError
    Dim grGroup As Graphic
    Dim gr As Graphic
    Dim i As Integer
    Dim count As Integer
    Dim ids() As Long

    count = ActiveDrawing.Selection.count
    If count = 0 Then
        MsgBox "No graphics selected"
        GoTo GroupError
    End If

    ReDim ids(0 To count - 1)

    'First make a group container
    Set grGroup = ActiveDrawing.Graphics.Add
    'Then add in the selected objects
    'This is made difficult because you the Selection object is not mutable
    'So we need to save the Graphic ID's in an array
    i = 0
    For Each gr In ActiveDrawing.Selection
        ids(i) = gr.ID
        i = i + 1
    Next
    'Not implemented!
    'ActiveDrawing.UnselectAll

    'Now recapture the ids and add the graphics to the group
    For i = 0 To count - 1
        Set gr = ActiveDrawing.Graphics.GraphicFromID(ids(i))

        'Selected no more
        gr.Unselect

        'Internal DBAPI Failure if you don't remove the graphic first
        ActiveDrawing.Graphics.Remove gr.Index
        grGroup.Graphics.AddGraphic gr
    Next
    Set GroupFromSelection = grGroup
    Exit Function

GroupError:
    Set GroupFromSelection = Nothing
End Function

Public Sub MakeBlockFromSelection()
    On Error GoTo BlockError
    Dim grGroup As Graphic
    Dim grInsert As Graphic

    Set grGroup = GroupFromSelection

    'Now make the block
    ActiveDrawing.Blocks.Add "Test", grGroup
    Set grGroup = Nothing

    'And do an insertion to see what we get
    Set grInsert = ActiveDrawing.Graphics.AddBlockInsertion("Test", 1, 1, 1)

    'Add modSelInfo.bas and modProperties.bas to use this
    'grInsert.Select
    'DebugPrintInfo False

    Exit Sub

BlockError:
    MsgBox "Error: " & Err.Description

End Sub


Examples - Bolt Macro - frmBolt.frm

frmBolt.frm

Bolt Macro Example

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmBolt
   Caption         =   "Parametric Bolt Inserter"
   ClientHeight    =   2295
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5085
   OleObjectBlob   =   "frmBolt.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "frmBolt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CommandButton1_Click()
    Me.Hide
End Sub


Examples - Bolt Macro - modBolt.bas

modBolt.bas

Bolt Macro Example

Attribute VB_Name = "modBolt"
' This sample draw different types of Bolts
'DBAPI constants
Const gkGraphic = 11
Const gkGroup = 7 ' imsiGroup
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265

' Hexagon Bolt Hexagon Bolt Hexagon Bolt Hexagon Bolt Hexagon Bolt Hexagon Bolt
' Hexagon Bolt Hexagon Bolt Hexagon Bolt Hexagon Bolt Hexagon Bolt Hexagon Bolt

Public Sub HexBolt()

Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim Gr As Graphic
Dim grfChild As Graphic
    Set App = IMSIGX.Application 'returns the application - TurboCAD
    Set ActDr = App.ActiveDrawing 'returns the current active drawing in the TurboCAd
    Set Grs = ActDr.Graphics ' returns the graphics collection on the active drawing
    Set Gr = Grs.Add(gkGroup) ' add new graphic to the graphics collection

Dim X0#, Y0#, X1#, Y1#, t#
Dim D#, L#, E#, F#, s#, del#, dd#
Dim W#, H#

    X0# = 2#
    Y0# = 2#
    frmBolt.Image1.Visible = True
    frmBolt.Image2.Visible = False
    frmBolt.Image3.Visible = False
    frmBolt.Show

    dd = CDbl(frmBolt.TextBox1.Text)
    L = CDbl(frmBolt.TextBox2.Text)

    D# = 1.75 * dd#
    H# = 0.65 * dd#
    E# = 0.8 * H#
    F# = D# / 4#
    s# = (L# - H#) / 2#
    del# = 0.1 * dd#
' add child graphics to parent graphic - Gr
'1
 Set grfChild = Gr.Graphics.AddLineSingle(X0#, Y0# + dd# / 2#, 0, X0# + L# - del#, Y0# + dd# / 2#, 0)
'2
 Set grfChild = Gr.Graphics.AddLineSingle(X0# + L# - del#, Y0# + dd# / 2#, 0, X0# + L# - del#, Y0# - dd# / 2#, 0)
'3
 Set grfChild = Gr.Graphics.AddLineSingle(X0#, Y0# - dd# / 2#, 0, X0# + L# - del#, Y0# - dd# / 2#, 0)
'4
 Set grfChild = Gr.Graphics.AddLineSingle(X0#, Y0# + D# / 2#, 0, X0#, Y0# - D# / 2#, 0)
'5
 Set grfChild = Gr.Graphics.AddLineSingle(X0#, Y0# + F#, 0, X0# - E#, Y0# + F#, 0)
'6
 Set grfChild = Gr.Graphics.AddLineSingle(X0#, Y0# - F#, 0, X0# - E#, Y0# - F#, 0)
'7
 Set grfChild = Gr.Graphics.AddLineSingle(X0# + (L# - s#), Y0# + dd# / 2#, 0, X0# + (L# - s#), Y0# - dd# / 2#, 0)
'8
 Set grfChild = Gr.Graphics.AddLineSingle(X0# + (L# - del#), Y0# + dd# / 2#, 0, X0# + L#, Y0# + dd# / 2# - del#, 0)
'9
 Set grfChild = Gr.Graphics.AddLineSingle(X0# + L#, Y0# + dd# / 2# - del#, 0, X0# + L#, Y0# - dd# / 2# + del#, 0)
'10
 Set grfChild = Gr.Graphics.AddLineSingle(X0# + (L# - del#), Y0# - dd# / 2#, 0, X0# + L#, Y0# - dd# / 2# + del#, 0)
'11
 Set grfChild = Gr.Graphics.AddArcTriplePoint(X0# - E#, Y0# + F#, 0, X0# - H#, Y0# + (D# / 2# + F#) / 2#, 0, X0# - E#, Y0# + D# / 2#, 0)
'12
 Set grfChild = Gr.Graphics.AddArcTriplePoint(X0# - E#, Y0# - F#, 0, X0# - H#, Y0# - (D# / 2# + F#) / 2#, 0, X0# - E#, Y0# - D# / 2#, 0)
'13
 Set grfChild = Gr.Graphics.AddArcTriplePoint(X0# - E#, Y0# + F#, 0, X0# - H#, Y0#, 0, X0# - E#, Y0# - F#, 0)
'14
 Set grfChild = Gr.Graphics.AddLineSingle(X0# + (L# - s#), Y0# + dd# / 2# - del#, 0, X0# + L#, Y0# + dd# / 2# - del#, 0)
'15
 Set grfChild = Gr.Graphics.AddLineSingle(X0# + (L# - s#), Y0# - dd# / 2# + del#, 0, X0# + L#, Y0# - dd# / 2# + del#, 0)
'16
 Set grfChild = Gr.Graphics.AddLineSingle(X0# - H#, Y0# + D# / 2# - (H# - E#), 0, X0# - H#, Y0# - D# / 2# + (H# - E#), 0)
'17
 Set grfChild = Gr.Graphics.AddLineSingle(X0#, Y0# + D# / 2#, 0, X0# - E#, Y0# + D# / 2#, 0)
'18
 Set grfChild = Gr.Graphics.AddLineSingle(X0# - E#, Y0# + D# / 2#, 0, X0# - H#, Y0# + D# / 2# - (H# - E#), 0)
'19
 Set grfChild = Gr.Graphics.AddLineSingle(X0#, Y0# - D# / 2#, 0, X0# - E#, Y0# - D# / 2#, 0)
'20
 Set grfChild = Gr.Graphics.AddLineSingle(X0# - E#, Y0# - D# / 2#, 0, X0# - H#, Y0# - D# / 2# + (H# - E#), 0)

End Sub

' Round Head Bolt  Round Head Bolt  Round Head Bolt  Round Head Bolt
' Round Head Bolt  Round Head Bolt  Round Head Bolt  Round Head Bolt

Public Sub RHBOLT()

Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim Gr As Graphic
Dim grfChild As Graphic
    Set App = IMSIGX.Application
    Set ActDr = App.ActiveDrawing
    Set Grs = ActDr.Graphics
'    Set Gr = Grs.Add(11)
    Set Gr = Grs.Add(gkGroup)

    'Add child Graphics
Dim X0#, Y0#, X1#, Y1#, t#
Dim D#, L#, E#, F#, s#, del#, dd#
Dim W#, H#

    X0# = 2#
    Y0# = 2#

    frmBolt.Image1.Visible = False
    frmBolt.Image2.Visible = True
    frmBolt.Image3.Visible = False
    frmBolt.Show

    dd = CDbl(frmBolt.TextBox1.Text)
    L = CDbl(frmBolt.TextBox2.Text)

    D# = 2.1 * dd#
    H# = 0.531 * dd#
    E# = 0.8 * H#
    F# = D# / 4#
    s# = (L# - H#) / 2#
    del# = 0.1 * dd#

'1
 Set grfChild = Gr.Graphics.AddLineSingle(X0#, Y0# + dd# / 2#, 0, X0# + L# - del#, Y0# + dd# / 2#, 0)
'2
 Set grfChild = Gr.Graphics.AddLineSingle(X0# + L# - del#, Y0# + dd# / 2#, 0, X0# + L# - del#, Y0# - dd# / 2#, 0)
'3
 Set grfChild = Gr.Graphics.AddLineSingle(X0#, Y0# - dd# / 2#, 0, X0# + L# - del#, Y0# - dd# / 2#, 0)
'4
 Set grfChild = Gr.Graphics.AddLineSingle(X0#, Y0# + D# / 2#, 0, X0#, Y0# - D# / 2#, 0)
'7
 Set grfChild = Gr.Graphics.AddLineSingle(X0# + (L# - s#), Y0# + dd# / 2#, 0, X0# + (L# - s#), Y0# - dd# / 2#, 0)
'8
 Set grfChild = Gr.Graphics.AddLineSingle(X0# + (L# - del#), Y0# + dd# / 2#, 0, X0# + L#, Y0# + dd# / 2# - del#, 0)
'9
 Set grfChild = Gr.Graphics.AddLineSingle(X0# + L#, Y0# + dd# / 2# - del#, 0, X0# + L#, Y0# - dd# / 2# + del#, 0)
'10
 Set grfChild = Gr.Graphics.AddLineSingle(X0# + (L# - del#), Y0# - dd# / 2#, 0, X0# + L#, Y0# - dd# / 2# + del#, 0)
'12
 Set grfChild = Gr.Graphics.AddArcTriplePoint(X0, Y0 - D / 2#, 0, X0 - H, Y0, 0, X0, Y0 + D / 2#, 0)
'14
 Set grfChild = Gr.Graphics.AddLineSingle(X0# + (L# - s#), Y0# + dd# / 2# - del#, 0, X0# + L#, Y0# + dd# / 2# - del#, 0)
'15
 Set grfChild = Gr.Graphics.AddLineSingle(X0# + (L# - s#), Y0# - dd# / 2# + del#, 0, X0# + L#, Y0# - dd# / 2# + del#, 0)

End Sub

' Round Head Square Neck Bolt  Round Head Square Neck Bolt
' Round Head Square Neck Bolt  Round Head Square Neck Bolt

Public Sub RHSNBOLT()

Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim Gr As Graphic
Dim grfChild As Graphic
    Set App = IMSIGX.Application
    Set ActDr = App.ActiveDrawing
    Set Grs = ActDr.Graphics
'    Set Gr = Grs.Add(11)
    Set Gr = Grs.Add(gkGroup)

    'Add child Graphics
Dim X0#, Y0#, X1#, Y1#, t#
Dim D#, L#, E#, F#, s#, del#, dd#
Dim W#, H#, P#

    X0# = 2#
    Y0# = 2#

    frmBolt.Image1.Visible = False
    frmBolt.Image2.Visible = False
    frmBolt.Image3.Visible = True

    frmBolt.Show
    dd = CDbl(frmBolt.TextBox1.Text)
    L = CDbl(frmBolt.TextBox2.Text)

    D# = 2.1 * dd#
    H# = 0.531 * dd#
    P# = 0.531 * dd#
    E# = 0.8 * H#
    W# = 1.41 * dd#
    del# = 0.1 * dd#

    '1
    ' Set grfChild = grfThis.Graphics.AddLineSingle(X0#, Y0# + dd# / 2#, 0, X0# + L# - del#, Y0# + dd# / 2#, 0)
    '                grfChild.Cosmetic = True
    '2
    ' Set grfChild = grfThis.Graphics.AddLineSingle(X0# + L# - del#, Y0# + dd# / 2#, 0, X0# + L# - del#, Y0# - dd# / 2#, 0)
    '                grfChild.Cosmetic = True
    '3
    ' Set grfChild = grfThis.Graphics.AddLineSingle(X0#, Y0# - dd# / 2#, 0, X0# + L# - del#, Y0# - dd# / 2#, 0)
    '                grfChild.Cosmetic = True
    '4
     Set grfChild = Gr.Graphics.AddLineSingle(X0#, Y0# + D# / 2#, 0, X0#, Y0# - D# / 2#, 0)
    '7
     Set grfChild = Gr.Graphics.AddLineSingle(X0# + L / 2#, Y0# + dd# / 2#, 0, X0# + L / 2#, Y0# - dd# / 2#, 0)
    '8
     Set grfChild = Gr.Graphics.AddLineSingle(X0# + (L# - del#), Y0# + dd# / 2#, 0, X0# + L#, Y0# + dd# / 2# - del#, 0)
    '9
     Set grfChild = Gr.Graphics.AddLineSingle(X0# + L#, Y0# + dd# / 2# - del#, 0, X0# + L#, Y0# - dd# / 2# + del#, 0)
    '10
     Set grfChild = Gr.Graphics.AddLineSingle(X0# + (L# - del#), Y0# - dd# / 2#, 0, X0# + L#, Y0# - dd# / 2# + del#, 0)
    '12
     Set grfChild = Gr.Graphics.AddArcTriplePoint(X0, Y0 - D / 2#, 0, X0 - H, Y0, 0, X0, Y0 + D / 2#, 0)
    '14
     Set grfChild = Gr.Graphics.AddLineSingle(X0 + L / 2#, Y0 + dd / 2# - del, 0, X0 + L, Y0 + dd / 2# - del, 0)
    '15
     Set grfChild = Gr.Graphics.AddLineSingle(X0 + L / 2#, Y0 - dd / 2# + del, 0, X0 + L, Y0 - dd / 2# + del, 0)
    '16
     Set grfChild = Gr.Graphics.AddLineSingle(X0, Y0 - W / 2#, 0, X0 + E, Y0 - W / 2#, 0)
    '17
     Set grfChild = Gr.Graphics.AddLineSingle(X0, Y0, 0, X0 + E, Y0, 0)
    '18
     Set grfChild = Gr.Graphics.AddLineSingle(X0, Y0 + W / 2#, 0, X0 + E, Y0 + W / 2#, 0)
    '19
     Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + E, Y0 - W / 2#, 0, X0 + P, Y0 - W / 4#, 0, X0 + E, Y0, 0)
    '20
     Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + E, Y0, 0, X0 + P, Y0 + W / 4#, 0, X0 + E, Y0 + W / 2#, 0)

    Dim R#
    R = (W * W / 4 + (P - E) * (P - E)) / (2# * (P - E))
    X1 = P - R
    Y1 = W / 4#
    X1 = X1 + Sqr(R * R - (dd / 2# - Y1) * (dd / 2# - Y1))
    X1 = X1 + X0
    '1
     Set grfChild = Gr.Graphics.AddLineSingle(X1#, Y0# + dd# / 2#, 0, X0# + L# - del#, Y0# + dd# / 2#, 0)
    '2
     Set grfChild = Gr.Graphics.AddLineSingle(X0# + L# - del#, Y0# + dd# / 2#, 0, X0# + L# - del#, Y0# - dd# / 2#, 0)
    '3
     Set grfChild = Gr.Graphics.AddLineSingle(X1#, Y0# - dd# / 2#, 0, X0# + L# - del#, Y0# - dd# / 2#, 0)
End Sub


Examples - Camera Macro - frmBitmapTest.frm

frmBitmapTest.frm

Camera Macro Example

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmBitmapTest
   Caption         =   "SDK Bitmap Test"
   ClientHeight    =   5670
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6120
   OleObjectBlob   =   "frmBitmapTest.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "frmBitmapTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Declare Function BitmapToPicture Lib "ViewPict" _
   (ByVal hDIB As Long) As Object

Private Declare Function MetafileToPicture Lib "ViewPict" _
   (ByVal hMeta As Long, ByVal width As Long, ByVal height As Long) As Object

Private Sub btnBitmap_Click()
    Dim obPic As StdPicture
    Dim vwActive As View
    Dim hDC As Long
    Dim hDIB As Long
    Set vwActive = ActiveDrawing.ActiveView
    hDC = vwActive.OpenBitmapDC
    vwActive.Refresh
    hDIB = vwActive.CloseBitmapDC
    Set obPic = BitmapToPicture(hDIB)
    If Not obPic Is Nothing Then
        Image1.Picture = obPic
    End If
End Sub

Private Sub btnMetafile_Click()
    Dim obPic As StdPicture
    Dim vwActive As View
    Dim hDC As Long
    Dim hMeta As Long
    Dim width, height As Long
    Set vwActive = ActiveDrawing.ActiveView
    hDC = vwActive.OpenMetafileDC
    vwActive.Refresh
    hMeta = vwActive.CloseMetafileDC
    width = Image1.width * 1.3333
    height = Image1.height * 1.3333
    Set obPic = MetafileToPicture(hMeta, width, height)
    If Not obPic Is Nothing Then
        'For some reason, the metafile picture is there,
        'But nothing is drawn
        Image1.Picture = obPic
    End If
End Sub


Examples - Camera Macro - frmCamera.frm

frmCamera.frm

Camera Macro Example

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmCamera
   Caption         =   "SDK Camera Test"
   ClientHeight    =   5760
   ClientLeft      =   30
   ClientTop       =   330
   ClientWidth     =   8835
   OleObjectBlob   =   "frmCamera.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "frmCamera"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const zoom_factor = 1.5
Const slide_factor = 0.1
Const tilt_pan_factor = 3.14159265358979 / 18 ' 10 degrees
Const rotate_factor = 3.14159265358979 / 18 ' 10 degrees

Private hwndForm As Long
Private vwForm As View

'FindWindow Win32 API
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
   (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Sub ClearCameraParams()
    tbxPosX = "Not available"
    tbxPosY = "Not available"
    tbxPosZ = "Not available"

    tbxLookAtX = "Not available"
    tbxLookAtY = "Not available"
    tbxLookAtZ = "Not available"

    tbxDirX = "Not available"
    tbxDirY = "Not available"
    tbxDirZ = "Not available"

    tbxUpX = "Not available"
    tbxUpY = "Not available"
    tbxUpZ = "Not available"

    tbxRightX = "Not available"
    tbxRightY = "Not available"
    tbxRightZ = "Not available"

    btnPerspective.Caption = "Not available"
End Sub

Private Sub RefreshCameraParams(gxCam As Camera)
    Dim gxVrt As Vertex

    Set gxVrt = gxCam.Location
    tbxPosX = Round(gxVrt.X, 6)
    tbxPosY = Round(gxVrt.Y, 6)
    tbxPosZ = Round(gxVrt.Z, 6)

    Set gxVrt = gxCam.LookAt
    tbxLookAtX = Round(gxVrt.X, 6)
    tbxLookAtY = Round(gxVrt.Y, 6)
    tbxLookAtZ = Round(gxVrt.Z, 6)

    Set gxVrt = gxCam.Direction
    tbxDirX = Round(gxVrt.X, 6)
    tbxDirY = Round(gxVrt.Y, 6)
    tbxDirZ = Round(gxVrt.Z, 6)

    Set gxVrt = gxCam.Up
    tbxUpX = Round(gxVrt.X, 6)
    tbxUpY = Round(gxVrt.Y, 6)
    tbxUpZ = Round(gxVrt.Z, 6)

    Set gxVrt = gxCam.Right
    tbxRightX = Round(gxVrt.X, 6)
    tbxRightY = Round(gxVrt.Y, 6)
    tbxRightZ = Round(gxVrt.Z, 6)

    If (gxCam.Perspective) Then
        btnPerspective.Caption = "Perspective"
    Else
        btnPerspective.Caption = "Not Perspective"
    End If
End Sub

Private Sub RefreshViewParams(gxVw As View)
    tbxVwLeft = Round(gxVw.ViewLeft, 6)
    tbxVwTop = Round(gxVw.ViewTop, 6)

    tbxVwWidth = Round(gxVw.ViewWidth, 6)
    tbxVwHeight = Round(gxVw.ViewHeight, 6)
End Sub

Private Sub btnOrbit_Click()
    Dim gxVw As View
    Dim gxCam As Camera
    Dim rf As Double
    rf = rotate_factor

    Set gxVw = ActiveDrawing.ActiveView
    If (gxVw.SpaceMode = imsiModelSpace) Then
        Set gxCam = gxVw.Camera
        gxCam.Perspective = True
        gxCam.Orbit rf, True, 10, 0, 0
        gxVw.Refresh
        gxCam.Perspective = False
        RefreshCameraParams gxCam
    Else
        MsgBox "Not available for Paper Space view"
    End If
    RefreshViewParams gxVw
End Sub

Private Sub btnPan_Click()
    Dim gxVw As View
    Dim gxCam As Camera
    Dim pf As Double
    pf = tilt_pan_factor

    Set gxVw = ActiveDrawing.ActiveView
    If (gxVw.SpaceMode = imsiModelSpace) Then
        Set gxCam = gxVw.Camera
        gxCam.Pan pf
        gxVw.Refresh
       RefreshCameraParams gxCam
    Else
        MsgBox "Not available for Paper Space view"
    End If

    RefreshViewParams gxVw
End Sub

Private Sub btnRotate_Click()
    Dim gxVw As View
    Dim gxCam As Camera
    Dim rf As Double
    rf = rotate_factor

    Set gxVw = ActiveDrawing.ActiveView
    If (gxVw.SpaceMode = imsiModelSpace) Then
        Set gxCam = gxVw.Camera
        gxCam.Perspective = True
        gxCam.Rotate rf, True, 10, 0, 0
        gxVw.Refresh
        gxCam.Perspective = False
       RefreshCameraParams gxCam
    Else
        MsgBox "Not available for Paper Space view"
    End If

    RefreshViewParams gxVw
End Sub

Private Sub ScrollViewLeftOrRight(ByVal gxVw As View, ByVal sf As Double)
    Dim gxCam As Camera
    Dim dSlide As Double
    dSlide = sf * gxVw.ViewWidth

    If (gxVw.SpaceMode = imsiModelSpace) Then
        Set gxCam = gxVw.Camera
        gxCam.Slide 0, dSlide
        gxVw.Refresh
       RefreshCameraParams gxCam
    Else
        gxVw.Update = False
        gxVw.Left = gxVw.Left + dSlide
        gxVw.Update = False
    End If

    RefreshViewParams gxVw
End Sub

Private Sub ScrollViewUpOrDown(ByVal gxVw As View, ByVal sf As Double)
    Dim gxCam As Camera
    Dim dSlide As Double
    dSlide = sf * gxVw.ViewHeight

    If (gxVw.SpaceMode = imsiModelSpace) Then
        Set gxCam = gxVw.Camera
        gxCam.Slide dSlide, 0
        gxVw.Refresh
       RefreshCameraParams gxCam
    Else
        gxVw.Update = False
        gxVw.Top = gxVw.Top + dSlide
        gxVw.Update = False
    End If

    RefreshViewParams gxVw
End Sub

Private Sub btnScrollLeft_Click()
    ScrollViewLeftOrRight ActiveDrawing.ActiveView, -slide_factor
End Sub

Private Sub btnScrollRight_Click()
    ScrollViewLeftOrRight ActiveDrawing.ActiveView, slide_factor
End Sub

Private Sub btnScrollUp_Click()
    ScrollViewUpOrDown ActiveDrawing.ActiveView, -slide_factor
End Sub

Private Sub btnScrollDown_Click()
    ScrollViewUpOrDown ActiveDrawing.ActiveView, slide_factor
End Sub

Private Sub btnTilt_Click()
    Dim gxVw As View
    Dim gxCam As Camera
    Dim tf As Double
    tf = tilt_pan_factor

    Set gxVw = ActiveDrawing.ActiveView
    If (gxVw.SpaceMode = imsiModelSpace) Then
        Set gxCam = gxVw.Camera
        gxCam.Tilt tf
        gxVw.Refresh
        RefreshCameraParams gxCam
    Else
        MsgBox "Not available for Paper Space view"
    End If

    RefreshViewParams gxVw
End Sub

Private Sub ZoomView(ByVal gxVw As View, ByVal zf As Double)
    Dim gxCam As Camera
    Dim x0 As Double
    Dim y0 As Double

    If (gxVw.SpaceMode = imsiModelSpace) Then
        Set gxCam = gxVw.Camera
        gxCam.zoom zf
        gxVw.Refresh
        RefreshCameraParams gxCam
    Else
        x0 = gxVw.Left + gxVw.ViewWidth / 2
        y0 = gxVw.Top - gxVw.ViewHeight / 2

        gxVw.Update = False

        gxVw.ViewWidth = gxVw.ViewWidth / zf
        gxVw.ViewHeight = gxVw.ViewHeight / zf

        gxVw.Left = x0 - gxVw.ViewWidth / 2
        gxVw.Top = y0 + gxVw.ViewHeight / 2

        gxVw.Update = False
    End If

    RefreshViewParams gxVw
End Sub

Private Sub ZoomViewToExtents(ByVal gxVw As View)
    Dim gxCam As Camera
    gxVw.ZoomToExtents

    If (gxVw.SpaceMode = imsiModelSpace) Then
        Set gxCam = gxVw.Camera
        RefreshCameraParams gxCam
    Else
        ClearCameraParams
    End If

    RefreshViewParams gxVw
End Sub

Private Sub btnZoomIn_Click()
    ZoomView ActiveDrawing.ActiveView, 1 / zoom_factor
End Sub

Private Sub btnZoomOut_Click()
    ZoomView ActiveDrawing.ActiveView, zoom_factor
End Sub

Private Sub btnZoomAll_Click()
    Dim vwActive As View
    Set vwActive = ActiveDrawing.ActiveView
    If Not vwForm Is Nothing Then
        ZoomViewToExtents vwForm
    End If
    ZoomViewToExtents vwActive
End Sub

Private Sub btnPerspective_Click()
    Dim gxVw As View
    Dim gxCam As Camera
    Set gxVw = ActiveDrawing.ActiveView

    If (gxVw.SpaceMode = imsiModelSpace) Then
        Set gxCam = gxVw.Camera

        If (gxCam.Perspective) Then
            gxCam.Perspective = False
        Else
            gxCam.Perspective = True
        End If

        gxVw.Refresh

        RefreshCameraParams gxCam
        RefreshViewParams gxCam
    Else
        MsgBox "Not available for Paper Space view"
    End If
End Sub

Private Sub btnHiddenLine_Click()
    Dim gxVw As View
    Dim gxRVw As RenderView
    Dim gxRnds As Renders
    Dim gxRnd As Render
    Set gxVw = ActiveDrawing.ActiveView

    If (gxVw.SpaceMode = imsiModelSpace) Then
        Set gxRVw = gxVw.RenderView

        If (gxRVw.IsRenderRunned) Then
            gxRVw.EndRender
        Else
            Set gxRnds = Application.Renders
            Set gxRnd = gxRnds("Hidden Line")

            gxRnd.Run gxVw
        End If
    Else
        MsgBox "Not available for Paper Space view"
    End If
End Sub

Private Sub AddFormView()
    Dim vwActive As View
    Dim dScale As Double

    On Error GoTo NoView
    If vwForm Is Nothing Then
        hwndForm = FindWindow(vbNullString, frmCamera.Caption)
        If hwndForm = 0 Then GoTo NoView

        Set vwActive = ActiveDrawing.ActiveView
        Set vwForm = ActiveDrawing.Views.Add(hwndForm)

        'Set up basic View behavior
        vwForm.FixedAspectRatio = True
        vwForm.Margins = True
        vwForm.CenterOnExtents = True
        vwForm.SpaceMode = vwActive.SpaceMode

        'Scale from dialog units to pixels
        dScale = 4# / 3#
        vwForm.ScreenWidth = fraView.width * dScale
        vwForm.ScreenHeight = fraView.height * dScale
        vwForm.ScreenLeft = fraView.Left * dScale
        vwForm.ScreenTop = fraView.Top * dScale

        'Copy the rest from primary view
        vwForm.ViewWidth = vwActive.ViewWidth
        vwForm.ViewHeight = vwActive.ViewHeight
        vwForm.ViewLeft = vwActive.ViewLeft
        vwForm.ViewTop = vwActive.ViewTop

        'And camera
        vwForm.Camera.Location = vwActive.Camera.Location
        vwForm.Camera.Up = vwActive.Camera.Up
        vwForm.Camera.LookAt = vwActive.Camera.LookAt

        ZoomViewToExtents vwForm
    End If
    Exit Sub

NoView:
    Set vwForm = Nothing
    MsgBox "Error setting up view"
End Sub

Private Sub UserForm_Activate()
    Dim gxVw As View
    Dim gxCam As Camera
    Set gxVw = ActiveDrawing.ActiveView

    If (gxVw.SpaceMode = imsiModelSpace) Then
        Set gxCam = gxVw.Camera
        RefreshCameraParams gxCam
    Else
        ClearCameraParams
    End If

    AddFormView
    RefreshViewParams gxVw
End Sub

Private Sub UserForm_Click()
    Dim gxVw As View
    Dim gxCam As Camera

    Set gxVw = ActiveDrawing.ActiveView
    RefreshViewParams gxVw

    If (gxVw.SpaceMode = imsiModelSpace) Then
        Set gxCam = gxVw.Camera
        RefreshCameraParams gxVw
    Else
        ClearCameraParams
    End If
End Sub


Examples - Camera Macro - modCamera.bas

modCamera.bas

Camera Macro Example

Attribute VB_Name = "modCamera"
Sub CameraTest()

    frmCamera.Show 0

End Sub


Examples - Camera Macro - ViewPict.cpp

ViewPict.cpp

Camera Macro Example

// ViewPict.cpp : Defines the entry point for the DLL application.
//

#include "stdafx.h"
#include "ViewPict.h"

BOOL APIENTRY DllMain( HANDLE hModule,
                       DWORD  ul_reason_for_call,
                       LPVOID lpReserved
                     )
{
    switch (ul_reason_for_call)
    {
        case DLL_PROCESS_ATTACH:
        case DLL_THREAD_ATTACH:
        case DLL_THREAD_DETACH:
        case DLL_PROCESS_DETACH:
            break;
    }
    return TRUE;
}

// IN: DIB memory object
// RETURNS: StdPicture object
// SIDE EFFECTS: original memory object is destroyed
//   StdPicture that is returned owns a DDB created from the original DIB
VIEWPICT_API IDispatch* __stdcall BitmapToPicture(HGLOBAL hDIB)
{
    // Convert DIB into DDB for use in PICTDESC
    BITMAPINFOHEADER* lpbi = (BITMAPINFOHEADER*)GlobalLock(hDIB);
    WORD nNumColors = (WORD)lpbi->biClrUsed;
    if (nNumColors == 0 && lpbi->biBitCount < 24)
        nNumColors = 1 << lpbi->biBitCount;	/* standard size table */
    WORD offBits = (WORD)lpbi->biSize + nNumColors * sizeof(RGBQUAD);
    LPSTR lpBits = (LPSTR)lpbi + offBits;

    HDC hDC = GetDC(NULL);
    HBITMAP hBitmap = CreateCompatibleBitmap(hDC, (WORD)lpbi->biWidth, (WORD)lpbi->biHeight);
    ::SetDIBits(hDC, hBitmap, 0, (WORD)lpbi->biHeight, lpBits, (BITMAPINFO*)lpbi, DIB_RGB_COLORS);

    // Done with original DIB
    GlobalUnlock(hDIB);
    GlobalFree(hDIB);
    hDIB = NULL;

    // Transfer ownership of DDB to StdPicture object
    PICTDESC pd;
    ZeroMemory(&pd, sizeof(pd));
    pd.cbSizeofstruct = sizeof(pd);
    pd.picType = PICTYPE_BITMAP;
    pd.bmp.hbitmap = hBitmap;
    pd.bmp.hpal = 0;

    IDispatch* pPicture = NULL;
    HRESULT hr = OleCreatePictureIndirect(&pd, IID_IDispatch, TRUE, (void**)&pPicture);

    // Done with DC
    ReleaseDC(NULL, hDC);

    if (FAILED(hr) || pPicture == NULL)
    {
        // Destroy failed bitmap
        DeleteObject(hBitmap);
        return 0;
    }

    // Success
    return pPicture;
}

// IN: Metafile handle
// RETURNS: StdPicture object
// SIDE EFFECTS: original Metafile object is destroyed on error,
//   otherwise, it is owned by the returned StdPicture object.
VIEWPICT_API IDispatch* __stdcall MetafileToPicture(HMETAFILE hMF, long width, long height)
{
    // Transfer ownership of Metafile to StdPicture object
    PICTDESC pd;
    ZeroMemory(&pd, sizeof(pd));
    pd.cbSizeofstruct = sizeof(pd);
    pd.picType = PICTYPE_METAFILE;
    pd.wmf.hmeta = (HMETAFILE)hMF;
    pd.wmf.xExt = width;
    pd.wmf.yExt = height;

    IDispatch* pPicture = NULL;
    HRESULT hr = OleCreatePictureIndirect(&pd, IID_IDispatch, TRUE, (void**)&pPicture);
    if (FAILED(hr) || pPicture == NULL)
    {
        // Destroy failed metafile
        DeleteMetaFile(hMF);
        return 0;
    }

    // Success
    return pPicture;
}


Examples - Camera Macro - ViewPict.h

ViewPict.h

Camera Macro Example

// The following ifdef block is the standard way of creating macros which make exporting
// from a DLL simpler. All files within this DLL are compiled with the VIEWPICT_EXPORTS
// symbol defined on the command line. this symbol should not be defined on any project
// that uses this DLL. This way any other project whose source files include this file see
// VIEWPICT_API functions as being imported from a DLL, wheras this DLL sees symbols
// defined with this macro as being exported.
#ifdef VIEWPICT_EXPORTS
//#define VIEWPICT_API __declspec(dllexport)
#define VIEWPICT_API
#else
#define VIEWPICT_API __declspec(dllimport)
#endif

#include <olectl.h>

extern "C" {
VIEWPICT_API IDispatch* __stdcall BitmapToPicture(HGLOBAL hDIB);
VIEWPICT_API IDispatch* __stdcall MetafileToPicture(HMETAFILE hMF, long width, long height);
}


Examples - Cloud Macro - Cloud1.bas

Cloud1.bas

Cloud Macro Example

Attribute VB_Name = "Cloud1"
' Converts a selected polyline into a "cloud"
Public Sub Cloud()

    Dim ActDr As Drawing
    Dim Grs As Graphics
    Dim GrPolygon As Graphic, GrCloud As Graphic
    Dim Vers As Vertices
    Dim Ver As Vertex, Ver1 As Vertex, Ver2 As Vertex
    Dim x As Double, y As Double, a As Double, alpha As Double, beta As Double, Pi As Double

    Set ActDr = IMSIGX.Application.ActiveDrawing

    If ActDr.Selection.Count = 0 Then
        Beep
        MsgBox "Please select a polyline to convert"
    Else
        Set GrPolygon = ActDr.Selection.Item(0)
        ' convert the segments into double arcs
        Set Vers = GrPolygon.Vertices
        n = Vers.Count

        ' find out the direction
        Area = PolyArea(GrPolygon)
        Direction = Sgn(Area)

        Set GrCloud = ActDr.Graphics.Add(imsiGroup)  ' will be a group

        For i = 1 To n - 1

            Set Ver1 = Vers.Item(i - 1)
            Set Ver2 = Vers.Item(i)

            Pi = (Atn(1) * 4)
            a = Atn2(Ver2.y - Ver1.y, Ver2.x - Ver1.x)
            If Direction > 0 Then
                alpha = Pi + a
                beta = 2 * Pi + a
            Else
                alpha = a
                beta = Pi + a
            End If
            ' add another vertex 2/3 from the first
            x = (Ver1.x + Ver2.x * 2) / 3
            y = (Ver1.y + Ver2.y * 2) / 3

            Set newarc = GrCloud.Graphics.AddArcCenterAndPoint((Ver1.x + x) / 2, (Ver1.y + y) / 2, 0, x, y, 0, alpha, beta)
            Set newarc = GrCloud.Graphics.AddArcCenterAndPoint((x + Ver2.x) / 2, (y + Ver2.y) / 2, 0, Ver2.x, Ver2.y, 0, alpha, beta)

        Next i

        GrPolygon.Unselect
        GrPolygon.Delete
        GrCloud.Select

    End If

End Sub

Function Atn2(dy As Double, dx As Double) As Double

    Dim Pi As Double

    Pi = (Atn(1) * 4)
    If dx <> 0 Then
        If dx > 0 Then
            retval# = Atn(dy / dx)
        Else
            retval# = Atn(dy / dx) + Pi
        End If
    Else
        retval# = Pi / 2 * Sgn(dy)
    End If
    Atn2 = retval#

End Function

Function PolyArea(Gr As Graphic) As Double

    Dim i As Integer
    Dim Vers As Vertices
    Dim Ver1 As Vertex, Ver2 As Vertex
    Dim Area As Double
    Area = 0
    Set Vers = Gr.Vertices
    ' for all vertices, find the area (using cross product)
    For i = 0 To Vers.Count - 2
        Set Ver1 = Vers.Item(i)
        Set Ver2 = Vers.Item(i + 1)
        '  i  j  k
        '  x1 y1 z1
        '  x2 y2 z2
        ' area = half the length of the cross product
        x1 = Ver1.x
        y1 = Ver1.y
        z1 = Ver1.Z
        x2 = Ver2.x
        y2 = Ver2.y
        z2 = Ver2.Z
        xx = y1 * z2 - y2 * z1
        yy = x1 * z2 - x2 * z1
        zz = x1 * y2 - x2 * y1
        Area = Area + Sqr(xx * xx + yy * yy + zz * zz) * Sgn(zz)
    Next i
    PolyArea = Area

End Function


Examples - Cloud Macro - modCloud.bas

modCloud.bas

Cloud Macro Example

Attribute VB_Name = "modCloud"
' Converts a selected polyline into a "cloud"
Public Sub Cloud()

    Dim ActDr As Drawing
    Dim Grs As Graphics
    Dim GrPolygon As Graphic, GrCloud As Graphic
    Dim Vers As Vertices
    Dim Ver As Vertex, Ver1 As Vertex, Ver2 As Vertex
    Dim x As Double, y As Double, a As Double, alpha As Double, beta As Double, Pi As Double

    Set ActDr = IMSIGX.Application.ActiveDrawing

    If ActDr.Selection.Count = 0 Then
        Beep
        MsgBox "Please select a polyline to convert"
    Else
        Set GrPolygon = ActDr.Selection.Item(0)
        ' convert the segments into double arcs
        Set Vers = GrPolygon.Vertices
        n = Vers.Count

        ' find out the direction
        Area = PolyArea(GrPolygon)
        Direction = Sgn(Area)

        Set GrCloud = ActDr.Graphics.Add(imsiGroup)  ' will be a group

        For i = 1 To n - 1

            Set Ver1 = Vers.Item(i - 1)
            Set Ver2 = Vers.Item(i)

            Pi = (Atn(1) * 4)
            a = Atn2(Ver2.y - Ver1.y, Ver2.x - Ver1.x)
            If Direction > 0 Then
                alpha = Pi + a
                beta = 2 * Pi + a
            Else
                alpha = a
                beta = Pi + a
            End If
            ' add another vertex 2/3 from the first
            x = (Ver1.x + Ver2.x * 2) / 3
            y = (Ver1.y + Ver2.y * 2) / 3

            Set newarc = GrCloud.Graphics.AddArcCenterAndPoint((Ver1.x + x) / 2, (Ver1.y + y) / 2, 0, x, y, 0, alpha, beta)
            Set newarc = GrCloud.Graphics.AddArcCenterAndPoint((x + Ver2.x) / 2, (y + Ver2.y) / 2, 0, Ver2.x, Ver2.y, 0, alpha, beta)

        Next i

        GrPolygon.Unselect
        GrPolygon.Delete
        GrCloud.Select

    End If

End Sub

Function Atn2(dy As Double, dx As Double) As Double

    Dim Pi As Double

    Pi = (Atn(1) * 4)
    If dx <> 0 Then
        If dx > 0 Then
            retval# = Atn(dy / dx)
        Else
            retval# = Atn(dy / dx) + Pi
        End If
    Else
        retval# = Pi / 2 * Sgn(dy)
    End If
    Atn2 = retval#

End Function

Function PolyArea(Gr As Graphic) As Double

    Dim i As Integer
    Dim Vers As Vertices
    Dim Ver1 As Vertex, Ver2 As Vertex
    Dim Area As Double
    Area = 0
    Set Vers = Gr.Vertices
    ' for all vertices, find the area (using cross product)
    For i = 0 To Vers.Count - 2
        Set Ver1 = Vers.Item(i)
        Set Ver2 = Vers.Item(i + 1)
        '  i  j  k
        '  x1 y1 z1
        '  x2 y2 z2
        ' area = half the length of the cross product
        x1 = Ver1.x
        y1 = Ver1.y
        z1 = Ver1.Z
        x2 = Ver2.x
        y2 = Ver2.y
        z2 = Ver2.Z
        xx = y1 * z2 - y2 * z1
        yy = x1 * z2 - x2 * z1
        zz = x1 * y2 - x2 * y1
        Area = Area + Sqr(xx * xx + yy * yy + zz * zz) * Sgn(zz)
    Next i
    PolyArea = Area

End Function


Examples - Common Macro Modules - modGraphicOps.bas

modGraphicOps.bas

Common Macro Modules Example

Attribute VB_Name = "modGraphicOps"
Option Explicit

Sub GraphicDeleteEx()
    Dim gr As Graphic

    'A very short-lived graphic
    Set gr = ActiveDrawing.Graphics.Add
    gr.Delete

    'Any of these calls will throw an error
    'Debug.Print "Deleted?  " & gr.Deleted
    'gr.Vertices.Add 1, 2, 3

    'It's good practice to clear the variable reference
    Set gr = Nothing
End Sub

Sub GraphicCopyEx()
    Dim gr0 As Graphic
    Dim gr As Graphic
    Dim i As Integer
    Dim x As Double
    Dim y As Double
    Dim mtx As Double

    'Make a circle centered at 1, 0, 0
    Set gr0 = ActiveDrawing.Graphics.AddCircleCenterAndPoint(1, 0, 0, 0, 0, 0)

    For i = 1 To 5
        'Clone original
        Set gr = gr0.Duplicate

        'Move to clone to point on the unit circle
        x = Cos(i * 3.14159 / 3)
        y = Sin(i * 3.14159 / 3)
        Set mtx = gr.MoveAbsolute(x, y, 0)
    Next i

    'Modify original -- clones are not affected
    With gr0.Properties
        .Item("BrushStyle") = "Solid"
        .Item("BrushColor") = NamedColors("Red")
    End With
End Sub

Sub GraphicRotateAxisEx()
    Dim gr0 As Graphic
    Dim gr As Graphic
    Dim i As Integer
    Dim mtx As Matrix

    Set gr0 = ActiveDrawing.Graphics(0)
    For i = 1 To 5
        Set gr = gr0.Duplicate
        Set mtx = gr.RotateAxis(i * 3.14159 / 6)
    Next

    'Modify original -- clones are not affected
    With gr0.Properties
        .Item("BrushStyle") = "Solid"
        .Item("BrushColor") = NamedColors("Red")
    End With
End Sub

Sub GraphicRotateAbsEx()
    Dim gr0 As Graphic
    Dim gr As Graphic
    Dim mtx As Matrix

    Set gr0 = ActiveDrawing.Graphics(0)
    Set gr = gr0.Duplicate
    Set mtx = gr.RotateAbsolute(1, 1, 0, 0, 0, 0)

End Sub

Sub GraphicScaleEx()
    Dim gr0 As Graphic
    Dim gr As Graphic
    Dim i As Integer
    Dim mtx As Matrix

    Set gr0 = ActiveDrawing.Graphics(0)
    Set gr = gr0.Duplicate
    Set mtx = gr.Scale(1, 2, 1)
    Set gr = gr0.Duplicate
    Set mtx = gr.Scale(2, 1, 1)
    Set gr = gr0.Duplicate
    Set mtx = gr.Scale(-1, 2, 1)
    Set gr = gr0.Duplicate
    Set mtx = gr.Scale(-2, 1, 1)
    Set gr = gr0.Duplicate
    Set mtx = gr.Scale(-1, -2, 1)
    Set gr = gr0.Duplicate
    Set mtx = gr.Scale(-2, -1, 1)
    Set gr = gr0.Duplicate
    Set mtx = gr.Scale(1, -2, 1)
    Set gr = gr0.Duplicate
    Set mtx = gr.Scale(2, -1, 1)

    'Modify original -- clones are not affected
    With gr0.Properties
        .Item("BrushStyle") = "Solid"
        .Item("BrushColor") = NamedColors("Red")
    End With
End Sub

Sub GraphicTransformEx()
    Dim gr0 As Graphic
    Dim gr As Graphic
    Dim mtx As Matrix

    Set mtx = New Matrix

    'Set up a pure translation matrix
    'Translation (5, 6, 7)
    mtx.SetEntries _
        1, 0, 0, 0, _
        0, 1, 0, 0, _
        0, 0, 0, 0, _
        5, 6, 7, 1

    Set gr0 = ActiveDrawing.Graphics(0)
    Set gr = gr0.Duplicate
    gr.Transform mtx
End Sub

Sub GraphicUCS()
    Dim gr As Graphic
    Dim mtx(0 To 15) As Double
    Dim i As Integer

    For Each gr In ActiveDrawing.Graphics
        gr.UCS.GetEntries _
            mtx(0), mtx(1), mtx(2), mtx(3), _
            mtx(4), mtx(5), mtx(6), mtx(7), _
            mtx(8), mtx(9), mtx(10), mtx(11), _
            mtx(12), mtx(13), mtx(14), mtx(15)

        Debug.Print "Matrix"
        Debug.Print mtx(0) & " " & mtx(1) & " " & mtx(2) & " " & mtx(3)
        Debug.Print mtx(4) & " " & mtx(5) & " " & mtx(6) & " " & mtx(7)
        Debug.Print mtx(8) & " " & mtx(9) & " " & mtx(10) & " " & mtx(11)
        Debug.Print mtx(12) & " " & mtx(13) & " " & mtx(14) & " " & mtx(15)
    Next
End Sub


Examples - Common Macro Modules - modProperties.bas

modProperties.bas

Common Macro Modules Example

Attribute VB_Name = "modProperties"
Option Explicit

Public Function PropertyFlagsAsString(ByVal prop As Property)
    On Error Resume Next
    Dim s As String
    s = ""
    If prop.IsAttribute Then s = s & "Attr "
    If prop.ReadOnly Then s = s & "RO   "
    PropertyFlagsAsString = s
End Function

Public Function PropertyTypeAsString(ByVal prop As Property)
    On Error Resume Next
    Dim s, s2 As String
    Dim t As Integer
    t = 0
    t = prop.Type
    If (t And vbArray) <> 0 Then
        t = t And 8191
        s2 = "()"
    Else
        s2 = ""
    End If
    Select Case t
        Case vbEmpty: s = "Empty"
        Case vbError: s = "Error"
        Case vbByte: s = "Byte"
        Case vbString: s = "String"
        Case vbBoolean: s = "Boolean"
        Case vbInteger: s = "Integer"
        Case vbLong: s = "Long"
        Case vbSingle: s = "Single"
        Case vbDouble: s = "Double"
        Case vbObject: s = "Object"
        Case Else:
            s = "?" & t
            MsgBox "Unknown type: " & t
    End Select
    PropertyTypeAsString = s & s2
End Function

Public Function PropertyValueAsString(ByVal prop As Property)
    On Error Resume Next
    Dim i, l, u, t As Integer
    Dim s As String
    Dim arr As Variant
    s = "<Err>"
    t = 0
    t = prop.Type
    If (t And vbArray) <> 0 Then
        arr = prop.Value
        l = LBound(arr)
        u = UBound(arr)
        s = "("
        For i = l To u
            s = s & arr(i)
            If i < u Then s = s & ", "
        Next
        s = s & ")"
    Else
        s = prop.Value
    End If
    PropertyValueAsString = s
End Function

Public Sub PrintPropertiesToFile(ByVal props As Properties)
    On Error Resume Next
    Dim i, count As Integer
    Dim prop As Property
    count = props.count
    Print #1, "      " & count & " Properties:"
    For i = 0 To count - 1
        Set prop = props(i)
        Print #1, "[" & i & "] Name " & prop.Name
        Print #1, "Flags " & PropertyFlagsAsString(prop)
        Print #1, " Type " & PropertyTypeAsString(prop)
        Print #1, "Value " & PropertyValueAsString(prop)
    Next
End Sub

Public Sub DebugPrintProperties(ByVal props As Properties)
    On Error Resume Next
    Dim i, count As Integer
    Dim prop As Property
    count = props.count
    Debug.Print "      " & count & " Properties:"
    For i = 0 To count - 1
        Set prop = props(i)
        Debug.Print " Name " & prop.Name
        Debug.Print "Flags " & PropertyFlagsAsString(prop)
        Debug.Print " Type " & PropertyTypeAsString(prop)
        Debug.Print "Value " & PropertyValueAsString(prop)
    Next
End Sub

Public Sub DebugAppProperties()
    DebugPrintProperties Application.Properties
End Sub

Public Sub DebugDwgProperties()
    DebugPrintProperties ActiveDrawing.Properties
End Sub


Examples - Bezier Curve Macro - DrawCurveBezier.bas

DrawCurveBezier.bas

Bezier Curve Macro Example

Attribute VB_Name = "DrawCurveBezier"
' Creates curve - Bezier and polygon from coordinates collection
Public Sub BezierCurve()
Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim GrBezier As Graphic
Dim GrPolygon As Graphic
Dim Ver As Vertex

    Set App = IMSIGX.Application
    Set ActDr = App.ActiveDrawing
    Set Grs = ActDr.Graphics
Dim x#, y#
Dim x0#, y0#, z0#
    x0 = 1#
    y0 = 5# + 2.5 * Sin(x0)
    z0 = 0#
' add two graphics GrBezier and GrPolygon to the graphics collection
' coordinates x0,y0,z0 - defines initial point of the graphic
    Set GrBezier = Grs.AddCurveBezier(x0, y0, z0)
    Set GrPolygon = Grs.AddLineIrregularPolygon(x0, y0, 0)
' add other points as Vertices to the graphic
    For x = 1 To 9 Step 1
        y = 5 + 2.5 * Sin(x)
        Set Ver = GrBezier.Vertices.Add(x, y, z0)
        Set Ver = GrPolygon.Vertices.Add(x, y, z0)
    Next x
' Changes some properties of the graphic
    GrBezier.Properties("PenWidth") = 0.03
    GrBezier.Properties("PenColor") = RGB(255, 0, 0)
    GrBezier.Properties("PenStyle") = "Dashed"
    GrBezier.Draw

    GrPolygon.Properties("PenWidth") = 0.03
    GrPolygon.Properties("PenColor") = RGB(0, 255, 0)
    GrPolygon.Draw

End Sub


Examples - Double Line Macro - modDblLine.bas

modDblLine.bas

Double Line Macro Example

Attribute VB_Name = "modDblLine"
' adds new graphic - DoubleLine to the active drawing
Public Sub AddDblLine()

Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim Gr As Graphic
    Set App = IMSIGX.Application
    Set ActDr = App.ActiveDrawing
    Set Grs = ActDr.Graphics
' DoubleLine is created as the RegenMethod with name - "TCW25DblLine"
    Set Gr = Grs.Add(, "TCW25DblLine")
' add base points to the graphic as Vertices
    With Gr.Vertices
        .Add 1, 1, 0
        .Add 5, 1, 0
        .Add 5, 5, 0
        .Add 1, 5, 0
    End With
    ActDr.Views(0).Refresh

End Sub


Examples - Double Line 2 Macro - modDblLine2.bas

modDblLine2.bas

Double Line 2 Macro Example

Attribute VB_Name = "modDblLine2"
Sub CreateDblLine1()
Dim ActDr As Drawing
Dim Grs As Graphics
Dim Gr As Graphic

    Set ActDr = ActiveDrawing
    Set Grs = ActDr.Graphics
Dim x() As Double
Dim y() As Double
Dim z() As Double
Dim NumPoints As Long, i As Long
    NumPoints = 3
ReDim x(NumPoints - 1)
ReDim y(NumPoints - 1)
ReDim z(NumPoints - 1)
    x(0) = 2: y(0) = 3: z(0) = 0
    x(1) = 5: y(1) = 6: z(1) = 0
    x(2) = 7: y(2) = 3: z(2) = 0
Dim Props As Properties

    Set Gr = Grs.Add(, "TCW25DblLine")
    Set Props = Gr.Properties
    Props("PenColor") = RGB(255, 0, 0)
    Props("PenWidth") = 0.02

    Props("$DLINEWID") = 0.33
    Props("$DLINECS") = 1
    Props("$DLINECE") = 1

    With Gr.Vertices
        For i = 0 To NumPoints - 1
            .Add x(i), y(i), z(i)
        Next i
    End With
    Gr.Draw

    Set Props = Nothing
    Set Gr = Nothing
    Set Grs = Nothing
    Set ActDr = Nothing

End Sub


Examples - Edit Circle Macro - frmEditCircle.frm

frmEditCircle.frm

Edit Circle Macro Example

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmEditCircle
   Caption         =   "Circle's coordinates of center and radius"
   ClientHeight    =   2760
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4710
   OleObjectBlob   =   "frmEditCircle.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "frmEditCircle"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CommandButton1_Click()
    Me.Hide
End Sub


Examples - Edit Circle Macro - modEditCircle.bas

modEditCircle.bas

Edit Circle Macro Example

Attribute VB_Name = "modEditCircle"

'Before start this script it is necessary to create some objects and to select a part from them

Public Sub CircleEdit()
' Edits coordinates of the centre and radius of a selected circle
Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim Gr As Graphic
Dim Vers As Vertices
Dim Ver As Vertex
Dim ObjSel As Selection
Dim NumSel As Long, i As Long
Dim GrSelType As String

    Set App = IMSIGX.Application    'Returns base application - TurboCAD
    Set ActDr = App.ActiveDrawing   'Returns Active Drawing
    Set ObjSel = ActDr.Selection    'Returns Selected objects as Selection collection
    NumSel = ObjSel.Count   'Returns the number of items in the collection.

    If NumSel = 0 Then
        MsgBox ("No circle was selected.Please select the circle and try again")
        Exit Sub
    End If
    For i = 0 To NumSel - 1
        Set Gr = ObjSel.Item(i) 'Returns part of a collection - graphic in the selection collection
        GrSelType = Gr.Type
        If GrSelType = "CIRCLE" Then
            Set Vers = Gr.Vertices ' Return the Vertices collection for current graphic - Circle
            Set Ver = Vers.Item(0) ' This Vertex is the center of the circle
Dim XcOld#, YcOld# ' coordinates of the center of the circle
Dim Xr#, Yr# ' coordinates the point on the circle
Dim ROld#
            XcOld = Ver.X
            YcOld = Ver.Y
            Set Ver = Vers.Item(1) 'This Vertex lies on the circle
            Xr = Ver.X
            Yr = Ver.Y
            ROld = Sqr((Xr - XcOld) * (Xr - XcOld) + (Yr - YcOld) * (Yr - YcOld))
            frmEditCircle.TextBox1.Text = CStr(XcOld)
            frmEditCircle.TextBox2.Text = CStr(YcOld)
            frmEditCircle.TextBox3.Text = CStr(ROld)
            frmEditCircle.Show
            Gr.Unselect

Dim XcNew#, YcNew#
Dim RNew#
            XcNew = CDbl(frmEditCircle.TextBox1.Text)
            YcNew = CDbl(frmEditCircle.TextBox2.Text)
            RNew = CDbl(frmEditCircle.TextBox3.Text)
Dim Matr As Matrix ' A transformation matrix
Dim xScale#, yScale#
Dim dx#, dy#
            xScale = RNew / ROld
            yScale = RNew / ROld
            dx = XcNew - XcOld
            dy = YcNew - YcOld
            Set Matr = Gr.Scale(xScale, yScale, 1)  'Scales the Graphic object.
            Set Matr = Gr.MoveRelative(dx, dy, 0)   'Moves the Graphic object by a specified offset
'            Gr.Select
        End If
    Next i
    ActDr.Views(0).Refresh
End Sub


Examples - Events Macro - clsEvents.cls

clsEvents.cls

Events Macro Example

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "clsEvents"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Sub BeforeDoubleClick(ByVal WhichDrawing As IMSIGX.Drawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Sel As IMSIGX.Selection, Cancel As IMSIGX.IMSI_BOOL)
    Debug.Print "BeforeDoubleClick"
    Cancel = False
End Sub

Public Sub BeforeExit(ByVal TheApp As IMSIGX.Application, Cancel As IMSIGX.IMSI_BOOL)
    Debug.Print "BeforeExit"
    Cancel = False
End Sub

Public Sub BeforeRightClick(ByVal WhichDrawing As IMSIGX.Drawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Sel As IMSIGX.Selection, Cancel As IMSIGX.IMSI_BOOL)
    Debug.Print "BeforeRightClick"
    Cancel = False
End Sub

Public Sub DrawingActivate(ByVal WhichDrawing As IMSIGX.Drawing)
    Debug.Print "DrawingActivate"
End Sub

Public Sub DrawingBeforeClose(ByVal WhichDrawing As IMSIGX.Drawing, Cancel As IMSIGX.IMSI_BOOL)
    Debug.Print "DrawingBeforeClose"
    Cancel = False
End Sub

Public Sub DrawingBeforeSave(ByVal WhichDrawing As IMSIGX.Drawing, SaveAs As IMSIGX.IMSI_BOOL, Cancel As IMSIGX.IMSI_BOOL)
    Debug.Print "DrawingBeforeSave " & CStr(SaveAs)
    Cancel = False
End Sub

Public Sub DrawingAfterSave(ByVal WhichDrawing As IMSIGX.Drawing)
    Debug.Print "DrawingAfterSave"
End Sub

Public Sub DrawingDeactivate(ByVal WhichDrawing As IMSIGX.Drawing)
    Debug.Print "DrawingDeactivate"
End Sub

Public Sub DrawingNew(ByVal WhichDrawing As IMSIGX.Drawing)
    Debug.Print "DrawingNew"
End Sub

Public Sub DrawingOpen(ByVal WhichDrawing As IMSIGX.Drawing)
    Debug.Print "DrawingOpen"
End Sub

Public Sub Drop(ByVal WhichDrawing As IMSIGX.Drawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Sel As IMSIGX.Selection)
    Debug.Print "Drop"
End Sub

Public Sub MouseDown(ByVal WhichDrawing As IMSIGX.Drawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Button As IMSIGX.ImsiMouseButton, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long, Cancel As IMSIGX.IMSI_BOOL)
    Debug.Print "MouseDown " & X & ", " & Y
    Cancel = False
End Sub

Public Sub MouseMove(ByVal WhichDrawing As IMSIGX.Drawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long, Cancel As IMSIGX.IMSI_BOOL)
    Debug.Print "MouseMove " & X & ", " & Y
    Cancel = False
End Sub

Public Sub MouseUp(ByVal WhichDrawing As IMSIGX.Drawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Button As IMSIGX.ImsiMouseButton, ByVal Shift As Long, ByVal X As Long, ByVal Y As Long, Cancel As IMSIGX.IMSI_BOOL)
    Debug.Print "MouseUp " & X & ", " & Y
    Cancel = False
End Sub

Public Sub RunTool(ByVal WhichTool As IMSIGX.Tool)
    Debug.Print "RunTool"
End Sub

Public Sub SelectionChange(ByVal WhichDrawing As IMSIGX.Drawing, ByVal WhichView As IMSIGX.View, ByVal WhichWindow As IMSIGX.Window, ByVal Sel As IMSIGX.Selection)
    Debug.Print "SelectionChange"
End Sub


Examples - Events Macro - frmEvents.frm

frmEvents.frm

Events Macro Example

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmEvents
   Caption         =   "Select Events"
   ClientHeight    =   3990
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3465
   OleObjectBlob   =   "frmEvents.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "frmEvents"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub FillListBox()
    On Error Resume Next

    lstEvents.ColumnCount = 2
    lstEvents.ColumnWidths = "-1;0"
    lstEvents.TextColumn = 1

    lstEvents.AddItem "BeforeExit"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventBeforeExit

    lstEvents.AddItem "DrawingNew"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventDrawingNew

    lstEvents.AddItem "DrawingOpen"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventDrawingOpen

    lstEvents.AddItem "DrawingActivate"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventDrawingActivate

    lstEvents.AddItem "DrawingDeactivate"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventDrawingDeactivate

    lstEvents.AddItem "DrawingBeforeClose"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventDrawingBeforeClose

    lstEvents.AddItem "DrawingBeforeSave"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventDrawingBeforeSave

    lstEvents.AddItem "MouseDown"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventMouseDown

    lstEvents.AddItem "MouseUp"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventMouseUp

    lstEvents.AddItem "MouseMove"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventMouseMove

    lstEvents.AddItem "BeforeDoubleClick"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventBeforeDoubleClick

    lstEvents.AddItem "BeforeRightClick"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventBeforeRightClick

    lstEvents.AddItem "SelectionChange"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventSelectionChange

    lstEvents.AddItem "RunTool"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventRunTool

    lstEvents.AddItem "Drop"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventDrop

    lstEvents.AddItem "DrawingAfterSave"
    lstEvents.List(lstEvents.ListCount - 1, 1) = imsiEventDrawingAfterSave
End Sub

Public Function GetEventMask() As Long
    On Error Resume Next
    Dim nCnt As Long
    Dim indItem As Long
    Dim mask As Long
    mask = 0
    nCnt = lstEvents.ListCount() - 1
    For indItem = 0 To nCnt
        If lstEvents.Selected(indItem) Then
            mask = mask + CLng(lstEvents.List(indItem, 1))
        End If
    Next indItem
    GetEventMask = mask
End Function

Private Sub btnClearAll_Click()
    Dim c1 As Variant
    Dim c2 As Variant
    Dim nCnt As Long
    Dim indItem As Long
    nCnt = lstEvents.ListCount() - 1
    For indItem = 0 To nCnt
        If lstEvents.Selected(indItem) Then
            c1 = lstEvents.List(indItem, 0)
            c2 = lstEvents.List(indItem, 1)
            lstEvents.RemoveItem indItem
            lstEvents.AddItem c1, indItem
            lstEvents.List(indItem, 1) = c2
        End If
    Next indItem
End Sub

Private Sub btnOK_Click()
    Me.Hide
End Sub

Private Sub UserForm_Activate()
    If lstEvents.ListCount = 0 Then FillListBox
End Sub


Examples - Events Macro - modEvents.bas

modEvents.bas

Events Macro Example

Attribute VB_Name = "modEvents"
Option Explicit

Dim eventHandler As New clsEvents
Dim idEvents As Long

Public Sub Main()
    On Error Resume Next
    Dim mask As Long
    frmEvents.Show
    mask = frmEvents.GetEventMask()
    If idEvents <> 0 Then
        Debug.Print "Disconnecting events " & idEvents
        Application.DisconnectEvents idEvents
        idEvents = 0
    End If
    If mask <> 0 Then
        On Error GoTo ConnectError
        idEvents = Application.ConnectEvents(eventHandler, mask)
        Debug.Print "Connected events " & idEvents
    End If
    Exit Sub

ConnectError:
    MsgBox "Error connecting events: " & Err.Description
End Sub


Examples - Excel Topographic Data Macro - modContour.bas

modContour.bas

Excel Topographic Data Macro Example

Attribute VB_Name = "modContour"
Option Explicit

'USGS DLG files have unix newline characters: Chr(10)
'VB's Line Input statement can only deal with Chr(13)-Chr(10) combinations
Function UnixLineInput(result As String) As Boolean
    On Error Resume Next

    result = ""
    If EOF(1) Then
        UnixLineInput = False
        Exit Function
    End If

    Dim c As String
    Do While True
        If EOF(1) Then Exit Do
        c = Input(1, #1)
        If c = Chr(10) Then Exit Do
        result = result & c
    Loop
    UnixLineInput = True
End Function

'Read contour line info from a USGS DLG file (optional format)
Sub ConvertContourDlgFile(ByVal fname As String, ByVal sheet As Excel.Worksheet)

    'For specifications, see: http://rockyweb.cr.usgs.gov/nmpstds/dlgstds.html
    'Part 2, Appendix 2-B lists file format records
    'Part 3 lists attribute codes (we use 21-25 to get contour elevation data)

    On Error Resume Next
    Dim i, nnodes, nareas, maxline As Integer
    Dim row, col As Long
    Dim line As String

    row = 1
    Open fname For Input As #1

    'Skip to first category line
    For i = 1 To 15
        If Not UnixLineInput(line) Then GoTo Finished
    Next

    'Get category parameters
    nnodes = CInt(Mid(line, 31, 6))
    nareas = CInt(Mid(line, 47, 6))
    maxline = CInt(Mid(line, 57, 6))

    'Skip nodes
    For i = 1 To nnodes
        Do While Left(line, 1) <> "N"
            If Not UnixLineInput(line) Then GoTo Finished
        Loop

        'Consume N record
        If Not UnixLineInput(line) Then GoTo Finished
    Next

    'Skip areas
    For i = 1 To nareas
        Do While Left(line, 1) <> "A"
            If Not UnixLineInput(line) Then GoTo Finished
        Loop

        'Consume A record
        If Not UnixLineInput(line) Then GoTo Finished
    Next

    'Read lines
    Dim idline, ncoords, maxcoords, natts, nchars, nrecs, j, k, l, m As Integer
    Dim col1, col2 As Integer
    Dim xarr() As Single
    Dim yarr() As Single
    Dim att1, att2 As Integer
    Dim elev As Single
    Dim hasElev As Boolean

    'Get a bunch of memory for our coordinate values
    maxcoords = 500
    ReDim xarr(maxcoords)
    ReDim yarr(maxcoords)

    For i = 1 To maxline
        Do While Left(line, 1) <> "L"
            If Not UnixLineInput(line) Then GoTo Finished
        Loop

        'Get line record parameters
        idline = CInt(Mid(line, 2, 5))
        ncoords = CInt(Mid(line, 43, 6))
        natts = CInt(Mid(line, 49, 6))
        nchars = CInt(Mid(line, 55, 6))

        'Consume L record
        If Not UnixLineInput(line) Then GoTo Finished

        'Get coordinates
        If ncoords > maxcoords Then
            maxcoords = ncoords
            ReDim xarr(maxcoords)
            ReDim yarr(maxcoords)
        End If
        k = 1 'coordinate number
        nrecs = (ncoords + 2) \ 3
        For j = 1 To nrecs
            col1 = 1
            col2 = 13
            l = 1 'coordinate index in record
            Do While k <= ncoords And l <= 3
                xarr(k) = CSng(Mid(line, col1, 12))
                yarr(k) = CSng(Mid(line, col2, 12))
                k = k + 1
                l = l + 1
                col1 = col1 + 24
                col2 = col2 + 24
            Loop
            UnixLineInput line
        Next

        'Get contour elevation attributes
        elev = 0
        hasElev = False
        k = 1 'attribute number
        nrecs = (natts + 5) \ 6
        For j = 1 To nrecs
            col1 = 1
            col2 = 7
            l = 1 'attribute index in record
            Do While k <= natts And l <= 6
                att1 = CInt(Mid(line, col1, 6))
                att2 = CInt(Mid(line, col2, 6))

                'Look for contour elevation attribute
                If att1 >= 21 And att1 <= 25 Then
                    Select Case att1
                    Case 21:
                        '10000 feet or more
                        elev = CSng(att2) + 10000
                    Case 22:
                        '0 to 9999 feet
                        elev = CSng(att2)
                    Case 23:
                        'below datum
                        elev = -CSng(att2)
                    Case 24:
                        'meters
                        elev = CSng(att2) / 0.3048
                    Case 25:
                        'meters below datum
                        elev = -CSng(att2) / 0.3048
                    End Select
                    hasElev = True
                End If
                k = k + 1
                l = l + 1
                col1 = col1 + 12
                col2 = col2 + 12
            Loop
            UnixLineInput line
        Next

        'Put contour into worksheet
        If hasElev Then
            nrecs = (ncoords + 99) \ 100
            k = 0
            For j = 1 To nrecs

                'How many coordinates in this row?
                m = ncoords - k
                If m > 100 Then m = 100

                With sheet.Cells
                    .Item(row, 1) = idline
                    .Item(row, 2) = k
                    .Item(row, 3) = m
                    .Item(row, 4) = elev
                    For l = 1 To m
                        .Item(row, l * 2 + 3) = xarr(k)
                        .Item(row, l * 2 + 4) = yarr(k)
                        k = k + 1
                    Next
                End With
            Next
        End If
    Next

Finished:
    Close #1
End Sub

Sub ConvertContours()
    'Data we're using is part of USGS's "Lake Tahoe Data Clearinghouse" model project
    'Sample file emer_hypso.dlg contains hypsography (contour) data for Emerald Bay 7.5' series
    'This and other DLG files are available for download at: http://tahoe.usgs.gov/tahoe/DLG.html

    On Error GoTo ConvertError
    Dim xlapp As New Excel.Application
    Dim xlbook As Excel.Workbook

    Set xlbook = xlapp.Workbooks.Add()
    'xlbook.ActiveSheet.Cells.Item(1, 1) = "Testing"
    ConvertContourDlgFile "J:\Samples\New\Excel\emer_hypso.dlg", xlbook.ActiveSheet
    xlbook.SaveAs "J:\Samples\New\Excel\contours.xls"

Cleanup:
    'Release Excel stuff
    Set xlbook = Nothing
    Set xlapp = Nothing
    Exit Sub

ConvertError:
    MsgBox "Error " & Err.Description
    GoTo Cleanup
End Sub

Sub ImportContours()
    On Error GoTo ImportError

    Dim xlapp As New Excel.Application

    'Test to see if Excel was initialized
    If xlapp Is Nothing Then
        MsgBox "Could not create Excel application object"
        Exit Sub
    End If

    Dim grs As IMSIGX.Graphics
    Dim gr As IMSIGX.Graphic
    Dim xlbook As Excel.Workbook

    'Open a workbook
    Set xlbook = xlapp.Workbooks.Open("J:\Samples\New\Excel\Contours.xls")
    If Not xlbook Is Nothing Then

        'Target to add graphics to
        Set grs = ActiveDrawing.Graphics

        Dim r As Long
        Dim coord As Long
        Dim id As Long
        Dim ncoords As Long
        Dim lastId As Long
        Dim x As Double
        Dim y As Double
        Dim z As Double

        'Format of worksheet
        'In each row:
        'Col 1:  id of contour line
        'Col 2:  starting coordinate index for this row
        'Col 3:  number of x-y coordinate pairs in this row
        'Col 4:  contour elevation (in feet)
        'Col 5, 7, etc.:  x coordinate (UTM, meters)
        'Col 6, 8, etc.:  y coordinate

        lastId = -1
        With xlbook.ActiveSheet.Cells
            For r = 1 To 65536

                'If no id, we're done
                If .Item(r, 1) = "" Then
                    Exit For
                End If

                id = .Item(r, 1)
                Debug.Print "id: " & id

                'New id: generate new polyline
                If id <> lastId Then
                    Set gr = grs.Add
                    lastId = id
                End If

                'Get number of coordinates and elevation
                ncoords = .Item(r, 3)
                z = .Item(r, 4)

                For coord = 1 To ncoords

                    'Get x-y coordinates and create polyline vertex
                    x = .Item(r, 2 * coord + 3)
                    y = .Item(r, 2 * coord + 4)
                    gr.Vertices.Add x, y, z
                Next
            Next
        End With
    End If

Cleanup:
    'Release TurboCAD stuff
    Set gr = Nothing
    Set grs = Nothing

    'Release Excel stuff
    Set xlbook = Nothing
    Set xlapp = Nothing
    Exit Sub

ImportError:
    MsgBox "Error " & Err.Description
    GoTo Cleanup
End Sub


Examples - TurboCAD in Excel Macro - modTcContour.bas

modTcContour.bas

TurboCAD in Excel Macro Example

Attribute VB_Name = "modTcContour"
Option Explicit

Sub BuildTurboCADContourMap()
    On Error GoTo BuildError

    Dim tcapp As IMSIGX.Application
    Dim dwg As IMSIGX.Drawing
    Set tcapp = CreateObject("TurboCAD.Application")
    If tcapp Is Nothing Then
        MsgBox "Could not create TurboCAD application"
        Exit Sub
    End If

    'Create a new drawing
    Set dwg = tcapp.Drawings.Add

    Dim grs As IMSIGX.Graphics
    Dim gr As IMSIGX.Graphic

    'Target to add graphics to
    Set grs = dwg.Graphics

    Dim r As Long
    Dim coord As Long
    Dim id As Long
    Dim ncoords As Long
    Dim lastId As Long
    Dim x As Double
    Dim y As Double
    Dim z As Double

    'Format of worksheet
    'In each row:
    'Col 1:  id of contour line
    'Col 2:  starting coordinate index for this row
    'Col 3:  number of x-y coordinate pairs in this row
    'Col 4:  contour elevation (in feet)
    'Col 5, 7, etc.:  x coordinate (UTM, meters)
    'Col 6, 8, etc.:  y coordinate

    lastId = -1
    With ThisWorkbook.ActiveSheet.Cells
        For r = 1 To 10

            'If no id, we're done
            If .Item(r, 1) = "" Then
                Exit For
            End If

            id = .Item(r, 1)
            Debug.Print "id: " & id

            'New id: generate new polyline
            If id <> lastId Then
                Set gr = grs.Add
                lastId = id
            End If

            'Get number of coordinates and elevation
            ncoords = .Item(r, 3)
            z = .Item(r, 4)

            For coord = 1 To ncoords

                'Get x-y coordinates and create polyline vertex
                x = .Item(r, 2 * coord + 3)
                y = .Item(r, 2 * coord + 4)
                gr.Vertices.Add x, y, z
            Next
        Next
    End With

    dwg.SaveAs "TestDwg.tcw"

Cleanup:
    'Release TurboCAD stuff
    Set gr = Nothing
    Set grs = Nothing
    Set dwg = Nothing
    tcapp.Quit
    Set tcapp = Nothing

    Exit Sub

BuildError:
    MsgBox "Error " & Err.Description
    GoTo Cleanup

End Sub


Examples - Excel Import Macro - ImportFromExcelspreadSheet.bas

ImportFromExcelspreadSheet.bas

Excel Import Macro Example

Attribute VB_Name = "ImportFromExcelspreadSheet"
Global appWorld As Excel.Application
Global wbWorld As Excel.Workbook
Global Path As String
Global W As Excel.Worksheet
Global XCur As Double
Global YCur As Double
Global ZCur As Double
Global ActDr As Drawing
Global Grs As Graphics
Global Gr As Graphic

Sub Run_Import()
MsgBox "Remember you should define correct path to the sample excel file !"
' define path to TurboCADv6.xls sample excel file
    Path = "d:\Temp\TurboCADv6.xls"
    Set ActDr = ActiveDrawing
    Set Grs = ActDr.Graphics
    Call Setup
    Call Import
    Call CleanUp
    ActDr.Views(0).Refresh
    Set Grs = Nothing
    Set ActDr = Nothing
End Sub
Private Sub Setup()
    ' IMPORTANT: If your machine does not have Excel 97 installed,
    ' you must change the reference to the Excel 95 Object Library.
    ' Then, in the Declarations section above, change the variable
    ' declaration "wbWorld as Workbook" to "shtWorld As Worksheet."
    ' Then change all references to "wbWorld" to "shtWorld."

    On Error Resume Next 'ignore errors
    Set appWorld = CreateObject("Excel.Application") 'run it
    Err.Clear   ' Clear Err object in case error occurred.
    On Error GoTo 0 'Resume normal error processing
    Set wbWorld = appWorld.Workbooks.Open(Path)
    Set W = wbWorld.Worksheets("Coordinates")
End Sub

' Set the objects to Nothing.
Private Sub CleanUp()
    ' This should force an unload of Microsoft Excel,
    ' providing no other applications or users have it loaded.
    wbWorld.Close False
    appWorld.Quit
    Set appWorld = Nothing
    Set wbWorld = Nothing
End Sub

Private Sub Import()
    Dim rngFeatureList As Excel.Range
    Dim intFirstBlankCell As Integer
    Dim loop1 As Integer
    Dim intColumOfFeature As Integer

 ' we use column 1 (x coordinates) to define how many records (x, y, z ) we have in SpreadSheet
    intColumOfFeature = 1
   ' Assign the column to an object.
    Set rngRankedList = W.Columns(intColumOfFeature)

    ' See if it's an empty list.
    If (rngRankedList.Cells(1, 1) = "") Then
        intFirstBlankCell = 0
    Else
        ' Search the row for the first blank cell.
        intFirstBlankCell = rngRankedList.Find("").Row
    End If

    ' row1 we have reserved for column header (X, Y, Z)
    'load first item to define start point
    XCur = W.Cells(2, 1)
    YCur = W.Cells(2, 2)
    ZCur = W.Cells(2, 3)

    Set Gr = Grs.AddLineMultiline(XCur, YCur, ZCur)
' you can add curve instead multiline or other graphic you would like
'    Set Gr = Grs.AddCurveBezier(XCur, YCur, ZCur)

    For loop1 = 3 To intFirstBlankCell - 1
        XCur = W.Cells(loop1, 1)
        YCur = W.Cells(loop1, 2)
        ZCur = W.Cells(loop1, 3)
        Gr.Vertices.Add XCur, YCur, ZCur
    Next
' if you would like to have closed multiline decoment next string
'    Gr.Close

End Sub


Examples - Extended Selection Info Macro - frmSelInfo.frm

frmSelInfo.frm

Extended Selection Info Macro Example

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmSelInfo
   Caption         =   "Extended Selection Information"
   ClientHeight    =   3765
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8430
   OleObjectBlob   =   "frmSelInfo.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "frmSelInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub btnCleanUp_Click()
    On Error Resume Next
    ClearInfoLayer
End Sub

Private Sub btnDrawVerts_Click()
    On Error Resume Next
    ClearInfoLayer
    DrawVertices chkAll.Value
End Sub

Private Sub btnDump_Click()
    On Error Resume Next
    PrintInfoToFile Trim(txtFilename.Text), chkAll.Value
End Sub

Private Sub btnGetInfo_Click()
    On Error Resume Next
    AddDrawingNodes tvwResults.Nodes, chkAll.Value
End Sub


Examples - Extended Selection Info Macro - modSelInfo.bas

modSelInfo.bas

Extended Selection Info Macro Example

Attribute VB_Name = "modSelInfo"
Option Explicit

Const lyrname As String = "_SelInfo"

Public Sub ShowSelForm()
    frmSelInfo.Show
End Sub

Sub ClearInfoLayer()
    On Error Resume Next
    Dim lyr As Layer

    Set lyr = ActiveDrawing.Layers.Item(lyrname)
    If Not lyr Is Nothing Then
        lyr.Clear
    End If
    ActiveDrawing.ActiveView.Refresh
End Sub

Sub PrintInfoToFile(ByVal fname As String, ByVal all As Boolean)
    On Error GoTo BadFile
    Dim sel As Selection
    Dim grs As Graphics
    Dim gfc As Graphic

    Open fname For Output As #1

    On Error Resume Next

    If all Then
        Set grs = ActiveDrawing.Graphics
        For Each gfc In grs
            PrintGraphicInfoToFile gfc, 0
        Next
    Else
        Set sel = ActiveDrawing.Selection
        For Each gfc In sel
            PrintGraphicInfoToFile gfc, 0
        Next
    End If
    Close #1
    MsgBox "File '" & fname & "' saved."
    Exit Sub

BadFile:
    MsgBox "Could not open file '" & fname & "'!"
End Sub

Private Sub PrintGraphicInfoToFile(gfc As Graphic, lvl As Integer)
    On Error Resume Next
    Dim i, count As Integer
    Dim s As String

    Print #1, ""
    Print #1, "--------"
    Print #1, "Graphic At Level " & lvl & ":"
    Print #1, "   ID " & gfc.ID
    Print #1, " Name " & gfc.Name
    Print #1, " Type " & gfc.Type
    s = "<Err>"
    s = gfc.RegenType
    Print #1, "Regen " & s
    s = ""
    If gfc.Builtin Then s = s & "Bilt "
    If gfc.Closed Then s = s & "Clsd "
    If gfc.Cosmetic Then s = s & "Cosm "
    If gfc.Deleted Then s = s & "Dele "
    If gfc.Editable Then s = s & "Edit "
    If gfc.Unbounded Then s = s & "Ubnd "
    If gfc.Visible Then s = s & "Vis  "
    Print #1, "Flags " & s

    count = gfc.Vertices.count
    Print #1, ""
    Print #1, "      " & count & " Vertices:"
    Dim vtx As Vertex
    For i = 0 To count - 1
        Set vtx = gfc.Vertices(i)
        Print #1,
        Print #1, "[" & i & "] at (" & vtx.x & ", " & vtx.y & ", " & vtx.z & ")"
        s = ""
        If vtx.PenDown Then s = s & "Down " Else s = s & "Up   "
        If vtx.Bulge Then s = s & "Blge "
        If vtx.Calculated Then s = s & "Calc "
        If vtx.Editable Then s = s & "Edit "
        If vtx.Linkable Then s = s & "Link "
        If vtx.Selectable Then s = s & "Sel  "
        If vtx.Snappable Then s = s & "Snap "
        Print #1, "Flags " & s
    Next i

    Print #1, ""
    PrintPropertiesToFile gfc.Properties

    Dim blk As Block
    Set blk = gfc.Block
    If Not blk Is Nothing Then
        s = blk.Name
        Print #1, ""
        Print #1, "      Block: " & s
        Set vtx = blk.Anchor
        Print #1,
        Print #1, "Anchor at (" & vtx.x & ", " & vtx.y & ", " & vtx.z & ")"
        count = blk.Graphics.count
        Print #1, ""
        Print #1, "      " & count & " Children:"
        For i = 0 To count - 1
            PrintGraphicInfoToFile blk.Graphics(i), lvl + 1
        Next i
        Print #1, "      End Block"
    End If

    'Sanity check
    If lvl > 4 Then Exit Sub

    count = gfc.Graphics.count
    Print #1, ""
    Print #1, "      " & count & " Children:"
    For i = 0 To count - 1
        PrintGraphicInfoToFile gfc.Graphics(i), lvl + 1
    Next i
End Sub

Sub DrawVertices(ByVal all As Boolean)
    Dim sel As Selection
    Dim grs As Graphics
    Dim gfc As Graphic
    Dim bbox As BoundingBox
    Dim sclX, sclY As Double

    If all Then
        Set grs = ActiveDrawing.Graphics
        For Each gfc In grs
            Set bbox = gfc.CalcBoundingBox
            sclX = Abs(bbox.Max.x - bbox.Min.x)
            sclY = Abs(bbox.Max.y - bbox.Min.y)
            If sclX < sclY Then sclX = sclY
            DrawGraphicVertices gfc, 0, sclX
        Next
    Else
        Set sel = ActiveDrawing.Selection
        For Each gfc In sel
            Set bbox = gfc.CalcBoundingBox
            sclX = Abs(bbox.Max.x - bbox.Min.x)
            sclY = Abs(bbox.Max.y - bbox.Min.y)
            If sclX < sclY Then sclX = sclY
            DrawGraphicVertices gfc, 0, sclX
        Next
    End If
End Sub

Private Sub DrawGraphicVertices(gfc As Graphic, lvl As Integer, ByVal scl As Double)
    On Error Resume Next
    Dim i, count As Integer
    Dim s As String
    Dim r, x, y, z As Double
    Dim lyr As Layer
    Dim vtx As Vertex
    Dim gi, gr1, gr2 As Graphic

    'Find or create special layer
    Set lyr = gfc.Drawing.Layers.Item(lyrname)
    If lyr Is Nothing Then
        Set lyr = gfc.Drawing.Layers.Add(lyrname)
    End If

    If lyr Is Nothing Then
        MsgBox "Couldn't access layer '" & lyrname & "'"
        Exit Sub
    End If

    Set gi = lyr.Add
    If gi Is Nothing Then
        MsgBox "Couldn't add graphic to layer"
        Exit Sub
    End If

    r = scl * 0.125
    z = (-lvl - 1) * scl / 4
    count = gfc.Vertices.count
    Set gr2 = lyr.Add
    For i = 0 To count - 1
        Set vtx = gfc.Vertices(i)
        x = vtx.x
        y = vtx.y
        Set gr1 = lyr.AddCircle(x, y, z)
        gr2.Vertices.Add x, y, z
    Next
    'gr2.LineStyle = gfc.Drawing.LineStyles("DOT")
    gr2.Properties("PenColor") = &HFF00

    'Sanity check
    If lvl > 4 Then Exit Sub

    count = gfc.Graphics.count
    For i = 0 To count - 1
        lvl = lvl + 1
        DrawGraphicVertices gfc.Graphics(i), lvl, scl
    Next
End Sub

Public Sub DebugPrintSelInfo()
    DebugPrintInfo False
End Sub

Sub DebugPrintInfo(ByVal all As Boolean)
    On Error Resume Next
    Dim sel As Selection
    Dim grs As Graphics
    Dim gfc As Graphic

    If all Then
        Set grs = ActiveDrawing.Graphics
        For Each gfc In grs
            DebugPrintGraphicInfo gfc, 0
        Next
    Else
        Set sel = ActiveDrawing.Selection
        For Each gfc In sel
            DebugPrintGraphicInfo gfc, 0
        Next
    End If
End Sub

Private Sub DebugPrintGraphicInfo(gfc As Graphic, lvl As Integer)
    On Error Resume Next
    Dim i, count As Integer
    Dim s As String

    Debug.Print ""
    Debug.Print "--------"
    Debug.Print "Graphic At Level " & lvl & ":"
    Debug.Print "   ID " & gfc.ID
    Debug.Print " Name " & gfc.Name
    Debug.Print " Type " & gfc.Type
    s = "<Err>"
    s = gfc.RegenType
    Debug.Print "Regen " & s
    s = ""
    If gfc.Builtin Then s = s & "Bilt "
    If gfc.Closed Then s = s & "Clsd "
    If gfc.Cosmetic Then s = s & "Cosm "
    If gfc.Deleted Then s = s & "Dele "
    If gfc.Editable Then s = s & "Edit "
    If gfc.Unbounded Then s = s & "Ubnd "
    If gfc.Visible Then s = s & "Vis  "
    Debug.Print "Flags " & s

    count = gfc.Vertices.count
    Debug.Print ""
    Debug.Print "      " & count & " Vertices:"
    Dim vtx As Vertex
    For i = 0 To count - 1
        Set vtx = gfc.Vertices(i)
        Debug.Print
        Debug.Print "[" & i & "] at (" & vtx.x & ", " & vtx.y & ", " & vtx.z & ")"
        s = ""
        If vtx.PenDown Then s = s & "Down " Else s = s & "Up   "
        If vtx.Bulge Then s = s & "Blge "
        If vtx.Calculated Then s = s & "Calc "
        If vtx.Editable Then s = s & "Edit "
        If vtx.Linkable Then s = s & "Link "
        If vtx.Selectable Then s = s & "Sel  "
        If vtx.Snappable Then s = s & "Snap "
        Debug.Print "Flags " & s
    Next i

    'Debug.Print ""
    'DebugPrintProperties gfc.Properties

    Dim blk As Block
    Set blk = gfc.Block
    If Not blk Is Nothing Then
        s = blk.Name
        Debug.Print ""
        Debug.Print "      Block: " & s
        Set vtx = blk.Anchor
        Debug.Print
        Debug.Print "Anchor at (" & vtx.x & ", " & vtx.y & ", " & vtx.z & ")"
        count = blk.Graphics.count
        Debug.Print ""
        Debug.Print "      " & count & " Children:"
        For i = 0 To count - 1
            DebugPrintGraphicInfo blk.Graphics(i), lvl + 1
        Next i
        Debug.Print "      End Block"
    End If

    'Sanity check
    If lvl > 4 Then Exit Sub

    count = gfc.Graphics.count
    Debug.Print ""
    Debug.Print "      " & count & " Children:"
    For i = 0 To count - 1
        DebugPrintGraphicInfo gfc.Graphics(i), lvl + 1
    Next i
End Sub


Examples - Extended Selection Info Macro - modSelNode.bas

modSelNode.bas

Extended Selection Info Macro Example

Attribute VB_Name = "modSelNode"
Option Explicit

Sub AddDrawingNodes(ByVal tvnodes As Nodes, ByVal all As Boolean)
    On Error Resume Next
    Dim nod As Node
    Dim sel As Selection
    Dim grs As Graphics
    Dim gfc As Graphic
    Dim nodeName As String

    If all Then
        nodeName = "Drawing"
    Else
        nodeName = "Selection"
    End If
    With tvnodes
        .Clear
        Set nod = .Add(, , "R", nodeName)
    End With
    If all Then
        Set grs = ActiveDrawing.Graphics
        For Each gfc In grs
            AddGraphicInfoToNode tvnodes, gfc, "R", 0
        Next gfc
    Else
        Set sel = ActiveDrawing.Selection
        For Each gfc In sel
            AddGraphicInfoToNode tvnodes, gfc, "R", 0
        Next gfc
    End If
End Sub

Private Sub AddGraphicInfoToNode(ByVal tvnodes As Nodes, ByVal gfc As Graphic, ByVal par As String, ByVal lvl As Integer)
    On Error Resume Next
    Dim i, count As Integer
    Dim s, n, v As String
    Dim kg, kv, kb, ki, kp As String
    Dim blk As IMSIGX.Block
    Dim nod As Node

    With tvnodes
        kg = "G" & gfc.ID
        n = gfc.Name
        If n = "" Then n = "<no name>"
        s = "<Err>"
        s = "Graphic ID " & gfc.ID & ", " & n & ": " & gfc.Type
        If gfc.Cosmetic Then s = s & " [Cosmetic]"
        Set nod = .Add(par, tvwChild, kg, s)
        s = "<Err>"
        s = gfc.RegenType
        Set nod = .Add(kg, tvwChild, , "Regen " & s)
        s = ""
        If gfc.Builtin Then s = s & "Bilt "
        If gfc.Closed Then s = s & "Clsd "
        If gfc.Cosmetic Then s = s & "Cosm "
        If gfc.Deleted Then s = s & "Dele "
        If gfc.Editable Then s = s & "Edit "
        If gfc.Unbounded Then s = s & "Ubnd "
        If gfc.Visible Then s = s & "Vis  "
        Set nod = .Add(kg, tvwChild, , "Flags " & s)

        count = gfc.Vertices.count
        If count > 0 Then
            kv = kg & "V"
            Set nod = .Add(kg, tvwChild, kv, count & " Vertices")
            Dim vtx As Vertex
            For i = 0 To count - 1
                Set vtx = gfc.Vertices(i)
                ki = kv & i
                v = "Up"
                If vtx.PenDown Then v = "Down"
                Set nod = .Add(kv, tvwChild, ki, "V[" & i & "]: (" & vtx.x & ", " & vtx.y & ", " & vtx.z & ") [" & v & "]")
                s = ""
                If vtx.PenDown Then s = s & "Down " Else s = s & "Up   "
                If vtx.Bulge Then s = s & "Blge "
                If vtx.Calculated Then s = s & "Calc "
                If vtx.Editable Then s = s & "Edit "
                If vtx.Linkable Then s = s & "Link "
                If vtx.Selectable Then s = s & "Sel  "
                If vtx.Snappable Then s = s & "Snap "
                Set nod = .Add(ki, tvwChild, , "Flags " & s)
            Next i
        End If

        count = gfc.Properties.count
        If count > 0 Then
            kp = kg & "P"
            Set nod = .Add(kg, tvwChild, kp, count & " Properties")
            Dim prop As Property
            For i = 0 To count - 1
                Set prop = gfc.Properties(i)
                ki = kp & i
                s = "<Err>"
                s = prop.Name & ": " & PropertyValueAsString(prop)
                Set nod = .Add(kp, tvwChild, ki, s)
                Set nod = .Add(ki, tvwChild, , "Flags " & PropertyFlagsAsString(prop))
                Set nod = .Add(ki, tvwChild, , "Type " & PropertyTypeAsString(prop))
            Next i
        End If

        'Sanity check
        If lvl > 4 Then Exit Sub

        Set blk = gfc.Block
        If Not blk Is Nothing Then
            kb = kg & "B"
            s = blk.Name
            Set nod = .Add(kg, tvwChild, kb, "Block: " & s)
            Set vtx = blk.Anchor
            Set nod = .Add(kb, tvwChild, , "Anchor: (" & vtx.x & ", " & vtx.y & ", " & vtx.z & ")")
            count = blk.Graphics.count
            If count > 0 Then
                ki = kg & "B-"
                Set nod = .Add(kb, tvwChild, ki, count & " Children")
                For i = 0 To count - 1
                    AddGraphicInfoToNode tvnodes, blk.Graphics(i), ki, lvl + 1
                Next i
            End If
        End If

        count = gfc.Graphics.count
        If count > 0 Then
            ki = kg & "-"
            Set nod = .Add(kg, tvwChild, ki, count & " Children")
            For i = 0 To count - 1
                AddGraphicInfoToNode tvnodes, gfc.Graphics(i), ki, lvl + 1
            Next i
        End If
    End With
End Sub


Examples - Extrude Text - modExtrudeText.bas

modExtrudeText.bas

Extrude Text Example

Attribute VB_Name = "modExtrudeText"
'All variables must be declared
Option Explicit

'Useful constant for rotations that need to be specified in radians
Const Pi# = 3.14159

'Text string to create
Const Text As String = "Hello, 3D World!"

'Height of text in world units
Const TextHeight# = 0.8

'Angle to draw text at (45 degrees)
Const TextAngle# = 45 * (Pi / 180)

'CountCosmetics
'Report how many child graphics are cosmetic
Private Function CountCosmetics(ByVal gr As Graphic)
    Dim cCosmetic As Long
    cCosmetic = 0
    With gr.Graphics
        Dim count As Long
        count = .count
        Dim i As Long
        For i = 0 To count - 1
            If .Item(i).Cosmetic Then cCosmetic = cCosmetic + 1
        Next
    End With
    CountCosmetics = cCosmetic
End Function

'DebugGraphicInfo
'Just dump some information into the Visual Basic Immediate Window
Private Sub DebugGraphicInfo(ByVal Name As String, ByVal gr As Graphic)
    Debug.Print Name & ": type = "; gr.Type
    Debug.Print " with " & gr.Vertices.count & " vertices"
    Debug.Print "  and " & gr.Graphics.count & " child graphics (" & _
        CountCosmetics(gr) & " cosmetic)"
End Sub

'CreateExtrudedText
'Example to demonstrate the use of TEXT and TCW40EXTRUDE graphic subtypes
'Steps in the macro:
'Step 1. Create and position a flexible text TEXT graphic
'Step 2. Explode the TEXT graphic into individual letters
'Step 3. Create an extrusion of each letter, varying the extrusion height and color
'Make it Public, in case you want to re-use this
Public Sub CreateExtrudedText()

    'Graphics collection that we create text and extrusions with
    Dim Grs As Graphics
    Set Grs = ActiveDrawing.Graphics

    'Step 1. Create and position a flexible TEXT graphic
    'AddText method takes string, starting point X, Y, Z, and height
    Dim GrText As Graphic
    Set GrText = Grs.AddText(Text, 0, 0, 0, TextHeight)
    DebugGraphicInfo "GrText created", GrText

    'Set the newly created TEXT graphic to "Flexible" type
    'Flexible text is described by polygons
    GrText.Properties("TextMode") = 3 'TextMode 3 = Flexible

    'Get TEXT graphic's center from it's bounding box
    Dim xc#, yc#, zc#
    With GrText.CalcBoundingBox
        xc = (.Max.X + .Min.X) / 2
        yc = (.Max.Y + .Min.Y) / 2
        zc = (.Max.Z + .Min.Z) / 2
    End With

    'Rotate the TEXT graphic 45 degrees about the Z axis
    'RotateAxis method takes angle, axis, and center of rotation
    GrText.RotateAxis TextAngle, 0, 0, 1, xc, yc, zc

    'Translate the TEXT graphic so that the center of the graphic is at 5, 5, 0
    Dim x0#, y0#, z0#
    x0 = 5: y0 = 5: z0 = 0
    GrText.MoveRelative x0 - xc, y0 - yc, z0 - zc

    'Step 2. Explode the TEXT graphic into individual letters
    'Exploding a flexible TEXT graphic returns a GraphicSet containing
    'only one graphic: a Group of graphics.

    'Explode method returns a GraphicSet; we take the first and only one (index 0).
    'GrExplode is a group object
    Dim GrExplode As Graphic
    Set GrExplode = GrText.Explode(0)
    DebugGraphicInfo "GrExplode created", GrExplode

    'Explode the group and get a GraphicSet, in which each graphic
    'is a polyline (with possible pen up segments) representing an individual letter.
    Dim GrSet As GraphicSet
    Set GrSet = GrExplode.Explode

    'Step 3. Create an extrusion of each letter, varying the extrusion height and color
    With GrSet

        'Get the size of the GraphicSet
        Dim GrSetCount As Long
        GrSetCount = .count

        'Go through each letter in the GraphicSet
        Dim i As Long
        For i = 0 To GrSetCount - 1

            'GrSect is a letter graphic left from the explosion
            Dim GrSect As Graphic
            Set GrSect = .Item(i)
            DebugGraphicInfo "GrSect(" & i & ") from set", GrSect

            'Deselect it; Explode always selects the result of the explosion
            GrSect.Properties("Selected") = 0

            'Create an extrusion
            'Add method takes RegenMethod optional parameter to create a Regen graphic
            Dim GrExtrude As Graphic
            Set GrExtrude = Grs.Add(RegenMethod:="TCW40EXTRUDE")
            DebugGraphicInfo "GrExtrude(" & i & ") created", GrExtrude

            'Make the extrusion graphic transparent
            GrExtrude.Properties("Solid") = 0

            'Give it one of the 16 "basic" colors
            'See the VBA documentation for QBColor...
            GrExtrude.Properties("PenColor") = QBColor(i + 1)

            'Take the letter graphic out of the drawing...
            Grs.Remove GrSect.Index

            '...and make it the child of the extrusion
            GrExtrude.Graphics.AddGraphic GrSect
            DebugGraphicInfo "GrExtrude(" & i & ") with base graphic", GrExtrude

            'Now add the extrusion vector origin (first vertex)
            GrExtrude.Vertices.Add 0, 0, 0

            'And extrusion vector end point (second vertex)
            Dim ExtrusionZ#
            ExtrusionZ = (i + 1) * TextHeight / 4
            GrExtrude.Vertices.Add 0, 0, ExtrusionZ
            DebugGraphicInfo "GrExtrude(" & i & ") before Update", GrExtrude

            'Force the Regen to generate the 3D polygons correctly
            'The Update command will also add a third vertex and the cosmetic graphics
            GrExtrude.Update
            DebugGraphicInfo "GrExtrude(" & i & ") after Update", GrExtrude

            'And draw the 3D letter on the view now
            GrExtrude.Draw
        Next
    End With
End Sub


Examples - Gear Macro - frmGear.frm

frmGear.frm

Gear Macro Example

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmGear
   Caption         =   "Gear Inserter"
   ClientHeight    =   6735
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8895
   OleObjectBlob   =   "frmGear.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "frmGear"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CommandButton1_Click()
    Me.Hide
End Sub


Examples - Gear Macro - modGear.bas

modGear.bas

Gear Macro Example

Attribute VB_Name = "modGear"

' This sample creates 3D-drawing of gear
Public Sub CreateGear()

Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim grfThis As Graphic
Dim Vers As Vertices
Dim Ver As Vertex
Dim grChild As Graphic
    Set App = IMSIGX.Application
    Set ActDr = App.ActiveDrawing
Dim Space%
    Space = ActDr.Properties("TileMode")
    If Space <> 1 Then
        MsgBox ("This macros works only in Modal Space")
        Exit Sub
    End If
    Set Grs = ActDr.Graphics
    Set grfThis = Grs.Add(7)
Dim Pi#
    Pi = 3.14159265
Dim X0#, Y0#, Z0#
    X0 = 5#
    Y0 = 5#
    Z0 = 0#
    frmGear.Show

Dim TeethNum# 'Count of Teeth
        TeethNum = CDbl(frmGear.TextBox1.Text)

 '        TeethNum = 40
Dim D0#, D1# 'External diameter
        D0 = CDbl(frmGear.TextBox2.Text)
        D1 = CDbl(frmGear.TextBox3.Text)
'        D0 = 3
'        D1 = 2.5
Dim n As Long
    n = TeethNum
Dim Rext#, Rint#, r1#, r2#, r3#
Dim fi#, dfi#, alp#, bet#, gam#
Dim xc#, yc#, zc#
Dim h#, H0#, H2#, H3#, H4#, H1#
        H0 = CDbl(frmGear.TextBox6.Text)
'        H0 = 0.5
Dim i As Long, j As Long
    Rext = D0 / 2
Dim m#
    m = D0 / (n + 2)
    h = 2.25 * m
    Rint = Rext - h
    r1 = D1 / 2
    xc = X0
    yc = Y0
    zc = Z0 - H0
    dfi = 2 * Pi / n
    alp = Pi / 3 / n
    bet = Pi / 3 / n
    gam = Pi / 3 / n
Dim xi#, yi#, zi#
    zi = zc
    j = 0
    Set grChild = grfThis.Graphics.Add(11)
Set Vers = grChild.Vertices
    For i = 0 To n - 1
        fi = i * dfi
        If i = 0 Then
            xi = xc + Rint * Cos(fi - (alp + bet))
            yi = yc + Rint * Sin(fi - (alp + bet))
            Set Ver = Vers.Add(xi, yi, zi, True)
        End If
        j = j + 1
        xi = xc + Rext * Cos(fi - alp)
        yi = yc + Rext * Sin(fi - alp)
        Set Ver = Vers.Add(xi, yi, zi, True)
        xi = xc + Rext * Cos(fi + alp)
        yi = yc + Rext * Sin(fi + alp)
        Set Ver = Vers.Add(xi, yi, zi, True)
        xi = xc + Rint * Cos(fi + (alp + bet))
        yi = yc + Rint * Sin(fi + (alp + bet))
        Set Ver = Vers.Add(xi, yi, zi, True)
        xi = xc + Rint * Cos(fi + (alp + bet + 2 * gam))
        yi = yc + Rint * Sin(fi + (alp + bet + 2 * gam))
        Set Ver = Vers.Add(xi, yi, zi, True)
    Next i
Dim xCon#, yCon#, zCon#
    xCon = xi
    yCon = yi
    zCon = zi

    dfi = 2 * Pi / 30
    For i = 0 To 30
        fi = -i * dfi
        xi = xc + r1 * Cos(fi)
        yi = yc + r1 * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False)

    grChild.Closed = True
    grChild.Properties("PenColor") = QBColor(8)
    grChild.Properties("Thickness") = 2 * H0
    grChild.Properties("Solid") = 0

' ----------------------------------------------------------------------
Dim D2#
        D2 = CDbl(frmGear.TextBox4.Text)
        H1 = CDbl(frmGear.TextBox7.Text)
'        D2 = 1.5
'        H1 = 0.25
    r1 = D1 / 2
    r2 = D2 / 2
    xc = X0
    yc = Y0
    zc = Z0 - H1
    zi = zc
    dfi = 2 * Pi / 30
    Set grChild = grfThis.Graphics.Add(11)
    Set Vers = grChild.Vertices

    For i = 0 To 30
        fi = i * dfi
        xi = xc + r1 * Cos(fi)
        yi = yc + r1 * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + r2 * Cos(fi)
        yi = yc + r2 * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = QBColor(8)
    grChild.Properties("Thickness") = 2 * H1
    grChild.Properties("Solid") = 0

' ----------------------------------------------------------------------
Dim Di#, ri#
        Di = CDbl(frmGear.TextBox5.Text)
        H2 = CDbl(frmGear.TextBox8.Text)
'        Di = 1
'        H2 = 0.7
    r2 = D2 / 2
    ri = Di / 2
    xc = X0
    yc = Y0
    zc = Z0 - H2
    zi = zc
    dfi = 2 * Pi / 30
    Set grChild = grfThis.Graphics.Add(11)
Set Vers = grChild.Vertices
    For i = 0 To 30
        fi = i * dfi
        xi = xc + r2 * Cos(fi)
        yi = yc + r2 * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + ri * Cos(fi)
        yi = yc + ri * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = QBColor(8)
    grChild.Properties("Thickness") = 2 * H2
    grChild.Properties("Solid") = 0
' ----------------------------------------------------------------------
    H3 = CDbl(frmGear.TextBox9.Text)
'    H3 = 1.5
    xc = X0
    yc = Y0
    H4 = H1 * 3
    zc = Z0 - H3
    zi = zc
    dfi = 2 * Pi / 30
    Set grChild = grfThis.Graphics.Add(11)
Set Vers = grChild.Vertices
    For i = 0 To 30
        fi = i * dfi
        xi = xc + ri * Cos(fi)
        yi = yc + ri * Sin(fi)
        zi = zc
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True)
        End If
    Next i
    grChild.Closed = True
    grChild.Properties("PenColor") = QBColor(8)
    grChild.Properties("Thickness") = 2 * H3
    grChild.Properties("Solid") = 0

' End gear
' --------------------------------------------------------------------------
' --------------------------------------------------------------------------
' --------------------------------------------------------------------------
' Begin Bearings  -  1
    H4 = CDbl(frmGear.TextBox10.Text)
'   H4 = 1
 Dim rb1#, rb2#, rb3#, rb4#
 Dim hb#
 Dim rr#
 Dim zb#
    rr = 0.2 * ri
    hb = 2 * rr
    zb = H4

'  First ring
    rb1 = ri
    rb2 = rb1 + hb / 4
    xc = X0
    yc = Y0
    zi = zb
    dfi = 2 * Pi / 30
    Set grChild = grfThis.Graphics.Add(11)
Set Vers = grChild.Vertices
    For i = 0 To 30
        fi = i * dfi
        xi = xc + rb2 * Cos(fi)
        yi = yc + rb2 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + rb1 * Cos(fi)
        yi = yc + rb1 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = RGB(0, 0, 255)
    grChild.Properties("Thickness") = hb
    grChild.Properties("Solid") = 0
' --------------------------------------------------------------------

'  Second ring
    rb3 = rb2 + 2 * rr
    rb4 = rb3 + hb / 4
    xc = X0
    yc = Y0
    zi = zb
    dfi = 2 * Pi / 30
    Set grChild = grfThis.Graphics.Add(11)
Set Vers = grChild.Vertices
   For i = 0 To 30
        fi = i * dfi
        xi = xc + rb4 * Cos(fi)
        yi = yc + rb4 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + rb3 * Cos(fi)
        yi = yc + rb3 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = RGB(0, 0, 255)
    grChild.Properties("Thickness") = hb
    grChild.Properties("Solid") = 0
' --------------------------------------------------------------------
' Draw Bolls as spheres
    zi = zb + hb / 2
    dfi = 2 * Pi / 16
    For i = 0 To 16
        fi = i * dfi
        xi = xc + (rb2 + rr) * Cos(fi)
        yi = yc + (rb2 + rr) * Sin(fi)
    Set grChild = grfThis.Graphics.Add(, "TCW40SPHERE")
Set Vers = grChild.Vertices
        Set Ver = grChild.Vertices.Add(xi, yi, zi, False)
        Set Ver = grChild.Vertices.Add(xi, yi, zi + rr, False)
        grChild.Properties("PenColor") = QBColor(4)
        grChild.Properties("Solid") = 0
    Next i

' --------------------------------------------------------------------------
' --------------------------------------------------------------------------
' --------------------------------------------------------------------------
' Begin Bearings  -  2
    rr = 0.2 * ri
    hb = 2 * rr
    zb = -H4 - hb

'  First ring
    rb1 = ri
    rb2 = rb1 + hb / 4
    xc = X0
    yc = Y0
    zi = zb
    dfi = 2 * Pi / 30
    Set grChild = grfThis.Graphics.Add(11)
Set Vers = grChild.Vertices
    For i = 0 To 30
        fi = i * dfi
        xi = xc + rb2 * Cos(fi)
        yi = yc + rb2 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + rb1 * Cos(fi)
        yi = yc + rb1 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = RGB(0, 0, 255)
    grChild.Properties("Thickness") = hb
    grChild.Properties("Solid") = 0
' --------------------------------------------------------------------

'  Second ring
    rb3 = rb2 + 2 * rr
    rb4 = rb3 + hb / 4
    xc = X0
    yc = Y0
    zi = zb
    dfi = 2 * Pi / 30
    Set grChild = grfThis.Graphics.Add(11)
Set Vers = grChild.Vertices
    For i = 0 To 30
        fi = i * dfi
        xi = xc + rb4 * Cos(fi)
        yi = yc + rb4 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True)
        End If
    Next i
    xCon = xi
    yCon = yi
    zCon = zi

    For i = 0 To 30
        fi = -i * dfi
        xi = xc + rb3 * Cos(fi)
        yi = yc + rb3 * Sin(fi)
        If i = 0 Then
            Set Ver = Vers.Add(xi, yi, zi, False)
        Else
            Set Ver = Vers.Add(xi, yi, zi, True)
        End If
    Next i
    Set Ver = Vers.Add(xCon, yCon, zCon, False)
    grChild.Closed = True
    grChild.Properties("PenColor") = RGB(0, 0, 255)
    grChild.Properties("Thickness") = hb
    grChild.Properties("Solid") = 0
' --------------------------------------------------------------------
' Draw Bolls as spheres
    zi = zb + hb / 2
    dfi = 2 * Pi / 16
    For i = 0 To 16
        fi = i * dfi
        xi = xc + (rb2 + rr) * Cos(fi)
        yi = yc + (rb2 + rr) * Sin(fi)
        Set grChild = grfThis.Graphics.Add(, "TCW40SPHERE")
        Set Vers = grChild.Vertices
        Set Ver = grChild.Vertices.Add(xi, yi, zi, False)
        Set Ver = grChild.Vertices.Add(xi, yi, zi + rr, False)
        grChild.Properties("PenColor") = QBColor(4)
        grChild.Properties("Solid") = 0
   Next i
End Sub


Examples - Graphic Methods Macro - Graphics1.bas

Graphics1.bas

Graphic Methods Macro Example

Attribute VB_Name = "Graphics1"
Public Sub TriplePoint()
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircleTriplePoint(0, 0, 0, 1, 1, 0, 0, 1, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(0, 0, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(1, 1, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(0, 1, 0)
End Sub
Public Sub ConstAngle() ' OK
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddConstructionAngularLine(0.5, 0, 0, 2.5, 4, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(0.5, 0, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(2.5, 4, 0)
End Sub
Public Sub ConstCPtCirc() ' OK
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddConstructionCenterAndPointCircle(2, 3, 0, 3, 2, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(2, 3, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(3, 2, 0)
End Sub
Public Sub Const2PtCirc() ' The first point is NOT on circumference
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddConstructionDoublePointCircle(2, 3, 0, 3, 2, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(2, 3, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(3, 2, 0)
End Sub
Public Sub Const3PtCirc() ' OK
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddConstructionTriplePointCircle(2, 3, 0, 3, 2, 0, 4, 4, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(2, 3, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(3, 2, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(4, 4, 0)
End Sub
Public Sub ConstHoriz() ' OK
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddConstructionHorizontalLine(0.5, 0, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(0.5, 0, 0)
End Sub
Public Sub ConstVert() ' OK
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddConstructionVerticalLine(2.5, 3, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(2.5, 3, 0)
End Sub
Public Sub Ellipse() ' OK
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddEllipse(2.5, 3, 0, 0.5, -2, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(2.5, 3, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(0.5, -2, 0)
End Sub
Public Sub EllFixed() ' the second point is NOT on circumference
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddEllipseFixedRatio(2, 3, 0, 1.5, 0, 0, 2)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(2, 3, 0)   ' center
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(1.5, 0, 0) ' circumference???
End Sub
Public Sub EllRotated() ' the third point does NOT define height properly
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddEllipseRotatedEllipse(1, 3, 0, 2.5, 4, 0, 5, 2, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(1, 3, 0)   ' center
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(2.5, 4, 0) ' big semi-axis???
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(5, 2, 0) ' hieght???
End Sub
Public Sub LinePar() ' no undo on the single line, the length of the parallel line is not the same
    Dim g1 As Graphic, g2 As Graphic
    Set g1 = IMSIGX.ActiveDrawing.Graphics.AddLineSingle(0, 0, 0, 2, 2, 0)
    Set g2 = IMSIGX.ActiveDrawing.Graphics.AddLineParallel(g1, 3, 0, 0)
    Set g2 = IMSIGX.ActiveDrawing.Graphics.AddSquare(0, 0, 0)
    Set g2 = IMSIGX.ActiveDrawing.Graphics.AddSquare(2, 2, 0)
    Set g2 = IMSIGX.ActiveDrawing.Graphics.AddSquare(3, 0, 0)
End Sub
Public Sub LinePerp() ' no undo on the single,  WHAT'S the role of the second point?
    Dim g1 As Graphic, g2 As Graphic
    Set g1 = IMSIGX.ActiveDrawing.Graphics.AddLineSingle(0, 0, 0, 2, 2, 0)
    Set g2 = IMSIGX.ActiveDrawing.Graphics.AddLinePerpendicular(g1, 3, 0, 0, 5, -1, 0)
    Set g2 = IMSIGX.ActiveDrawing.Graphics.AddSquare(0, 0, 0)
    Set g2 = IMSIGX.ActiveDrawing.Graphics.AddSquare(2, 2, 0)
    Set g2 = IMSIGX.ActiveDrawing.Graphics.AddSquare(3, 0, 0)
    Set g2 = IMSIGX.ActiveDrawing.Graphics.AddSquare(5, -1, 0) ' what is this for???
End Sub
Public Sub RotRect() ' Non-intuitive - what direction is "height"?
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddLineRotatedRectangle(3, 0, 0, 5, 1, 0, 2)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(3, 0, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(5, 1, 0)
End Sub
Public Sub Polylines() ' I can't figure this out.  Gives "wrong argument" error.
    Dim g As Graphic, gs As GraphicSet
    Dim coords As Variant ' ARRAY
    Dim closed As IMSI_BOOL
    Dim num As Long
    closed = 0
    num = 2
    coords = Array(0#, 0#, 0#, 1#, 0#, 0#, 1.5, 1#, 0#, 0.5, 2.5, 0#, 3#, 0#, 0#, 4#, 0#, 0#, 4#, 1#, 0#, 2.5, 2#, 0#)
    Set gs = IMSIGX.ActiveDrawing.Graphics.AddPolylines(num, coords, closed)
End Sub
Public Sub Irreg()
    Dim gs As GraphicSet
    Dim coords As Variant ' ARRAY
    coords = Array(0, 0, 0, 1, 0, 0, 1.5, 1, 0, 0.5, 2.5, 0, 3, 0, 0, 4, 0, 0, 4, 1, 0, 2.5, 2, 0)
    Set gs = IMSIGX.ActiveDrawing.Graphics.AddPolys(imsiIrregPolygon, coords)
End Sub
Public Sub CreateBlock()
    Dim g As Block
    Set g = IMSIGX.ActiveDrawing.Graphics.CreateBlock("BLockNAme")
End Sub
Public Sub TXform()  ' No UNDO.
    Dim m As New Matrix
    Dim gs As Graphics
    m.Rotate 0, 0, 1, 3.1415926 / 6#, 0, 0, 0
    Set gs = IMSIGX.ActiveDrawing.Graphics
    gs.Transform m
End Sub


Examples - Graphic Methods Macro - Graphics2.bas

Graphics2.bas

Graphic Methods Macro Example

Attribute VB_Name = "Graphics2"
Public Sub Add() ' What TYPES are there?  Can it REALLY be used in VBA?
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.Add(11)
End Sub
Public Sub ArcCtPt() ' OK
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddArcCenterAndPoint(2, 3, 0, -5, 2, 0, 1.5, 4.2)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(2, 3, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(-5, 2, 0)
End Sub
Public Sub ArcEll() ' OK
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddArcElliptical(2, 3, 0, -5, 0, 0, 1, 5.5)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(2, 3, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(-5, 0, 0)
End Sub
Public Sub ArcEllFixed() ' Wrong: the second point is to be on the circumference!!!
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddArcEllipticalFixedRatio(2, 3, 0, -5, 0, 0, 2, 1, 5.5)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(2, 3, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(-5, 0, 0)
End Sub
Public Sub ArcEllRot() ' Wrong: the third point is to define the axis as distance to the 1-2 line!
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddArcRotatedElliptical(2, 3, 0, -5, 0, 0, -1, -1, 0, 1, 5.5)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(2, 3, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(-5, 0, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddSquare(-1, -1, 0)
End Sub
Public Sub Circ() ' OK
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircleCenterAndPoint(2, 3, 0, -5, 0, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(2, 3, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(-5, 0, 0)
End Sub
Public Sub Bezier() ' NOT OK -- adds the spline
    Dim g1 As Graphic, g As Graphic
    Set g1 = IMSIGX.ActiveDrawing.Graphics.AddCurveBezier(3, 3, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 3, 0)
    Set v = g1.Vertices.Add(2.5, 4, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(2.5, 4, 0)
    Set v = g1.Vertices.Add(3, 5, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 5, 0)
    Set v = g1.Vertices.Add(3, 6, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 6, 0)
    Set v = g1.Vertices.Add(4, 5, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(4, 5, 0)
End Sub
Public Sub Spline() ' NOT OK -- adds the Bezier
    Dim g1 As Graphic, g As Graphic
    Set g1 = IMSIGX.ActiveDrawing.Graphics.AddCurveSpline(3, 3, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 3, 0)
    Set v = g1.Vertices.Add(2.5, 4, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(2.5, 4, 0)
    Set v = g1.Vertices.Add(3, 5, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 5, 0)
    Set v = g1.Vertices.Add(3, 6, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 6, 0)
    Set v = g1.Vertices.Add(4, 5, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(4, 5, 0)
End Sub
Public Sub Irreg() ' NOT OK -- Doesn't keep the polygon closed
    Dim g1 As Graphic, g As Graphic
    Set g1 = IMSIGX.ActiveDrawing.Graphics.AddLineIrregularPolygon(3, 3, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 3, 0)
    Set v = g1.Vertices.Add(2.5, 4, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(2.5, 4, 0)
    Set v = g1.Vertices.Add(3, 5, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 5, 0)
    Set v = g1.Vertices.Add(3, 6, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 6, 0)
    Set v = g1.Vertices.Add(4, 5, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(4, 5, 0)
End Sub
Public Sub Multi() ' OK
    Dim g1 As Graphic, g As Graphic
    Set g1 = IMSIGX.ActiveDrawing.Graphics.AddLineMultiline(3, 3, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 3, 0)
    Set v = g1.Vertices.Add(2.5, 4, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(2.5, 4, 0)
    Set v = g1.Vertices.Add(3, 5, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 5, 0)
    Set v = g1.Vertices.Add(3, 6, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 6, 0)
    Set v = g1.Vertices.Add(4, 5, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(4, 5, 0)
End Sub
Public Sub Polyg() ' OK
    Dim g1 As Graphic, g As Graphic
    Set g1 = IMSIGX.ActiveDrawing.Graphics.AddLinePolygon(3, 1, 0, 2.5, 4, 0, 6)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 1, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(2.5, 4, 0)
End Sub
Public Sub Rect() ' OK
    Dim g1 As Graphic, g As Graphic
    Set g1 = IMSIGX.ActiveDrawing.Graphics.AddLineRectangle(3, 1, 0, 2.5, 4, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 1, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(2.5, 4, 0)
End Sub
Public Sub Text() ' OK -- need to test other parameters (width, offset, justification)
    Dim g1 As Graphic, g As Graphic
    Set g1 = IMSIGX.ActiveDrawing.Graphics.AddText("This is a test", 3, 1, 0, 1.5, 1)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 1, 0)
End Sub
Public Sub MoveA() ' OK but NO UNDO!!!
    Dim m As Matrix, g As Graphic
    Set m = IMSIGX.ActiveDrawing.Graphics.MoveAbsolute(3, 1, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 1, 0)
End Sub
Public Sub MoveR() ' OK but NO UNDO!!!
    Dim m As Matrix, g As Graphic
    Set m = IMSIGX.ActiveDrawing.Graphics.MoveRelative(3, 1, 0)
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 1, 0)
End Sub
Public Sub ScaleIt() ' OK but NO UNDO!!!
    Dim m As Matrix, g As Graphic
    Set m = IMSIGX.ActiveDrawing.Graphics.Scale(3, 1, 0)
    'Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(3, 1, 0)
End Sub
Public Sub CalcBox() ' What the hell does it count?
    Dim box As BoundingBox
    Set box = IMSIGX.ActiveDrawing.Graphics.CalcBoundingBox
    MsgBox "Bounding box: " + Str(box.Min.X) + "," + Str(box.Min.Y) + "," + Str(box.Max.X) + "," + Str(box.Max.Y)
End Sub
Public Sub CountEm() ' What the hell does it count?
    N = IMSIGX.ActiveDrawing.Graphics.Count
    MsgBox "Total Number is " + Str(N)
End Sub


Examples - Graphic Methods Macro - IGraphic.bas

IGraphic.bas

Graphic Methods Macro Example

Attribute VB_Name = "IGraphic"
Public Sub ArcSet() ' all parameters are optional, what's to do?
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    g.ArcSet
End Sub
Public Sub Attribs() ' ?????????  What is an attribute?????
    Dim g As Graphic, p As Property
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    If g.Attributes.Count > 0 Then
        Set p = g.Attributes(1)
        MsgBox "Property 0 is " + p.Name
    Else
        MsgBox "This graphic has no attributes"
    End If
End Sub
Public Sub GetBlock() ' OK
    Dim g As Graphic, b As Block
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    Set b = g.Block
    If b Is Nothing Then
        MsgBox "The selected graphic is not an insert"
    Else
        MsgBox "Block is '" + b.Name + "'"
    End If
End Sub
Public Sub ToFront() ' NOT OK -- Must not lose the "selected" flag
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    g.BringToFront
End Sub
Public Sub ToBack() ' NOT OK -- Must not lose the "selected" flag
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    g.SendToBack
End Sub
Public Sub BrStyle() ' OK
    Dim g As Graphic, bs As BrushStyle
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    Set bs = g.BrushStyle
    If bs Is Nothing Then
        MsgBox "No brush style"
    Else
        MsgBox "Brush Style is '" + bs.Name + "'"
    End If
End Sub
Public Sub IsBltIn() ' OK
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    a = g.Builtin
    MsgBox "BuiltIn returns " + Str(a)
End Sub
Public Sub BBox() ' ONLY works on cosmetics - no geometry.
    Dim g As Graphic, box As BoundingBox
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    Set box = g.CalcBoundingBox
    MsgBox "Bounding box: " + Str(box.Min.X) + "," + Str(box.Min.Y) + "," + Str(box.Max.X) + "," + Str(box.Max.Y)
End Sub
Public Sub Clos() '  NO UNDO.
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    If g.Closed Then
        MsgBox "Already closed"
    Else
        g.Close    ' Does NOT redraw
    End If
End Sub
Public Sub Dup() '  NO UNDO.
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    Set g = g.Duplicate
End Sub
Public Sub ArcData() '  ??????????????????? - how to use????
    Dim g As Graphic, d As Variant
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    g.GetArcData d
End Sub
Public Sub Nodes() '  OK
    Dim g As Graphic, vs As Vertices
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    Set vs = g.Nodes
    MsgBox Str(vs.Count) + " nodes in it"
End Sub
Public Sub Name() '  OK -- gives back the "Attribute"
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    MsgBox g.Name
End Sub
Public Sub Props() '  FAILS on the 8th property: TextStyle
    Dim g As Graphic, ps As Properties
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    s$ = ""
    Set ps = g.Properties
    For i = 0 To ps.Count - 1
        s$ = s$ + ps(i).Name + "=" + Str(ps(i).Type)
    Next i
    MsgBox s$
End Sub
Public Sub gType() ' OK
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    MsgBox g.Type ' returns a string
End Sub
Public Sub gTypeVal() ' OK
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    MsgBox Str(g.TypeByValue) ' returns a string
End Sub
Public Sub unHideIt() ' OK - but doesn't REDRAW
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    If g.Visible Then
        g.Visible = False
    Else
        g.Visible = True
    End If
End Sub
Public Sub GetDist() ' Wrong -- returns the square of the distance
    Dim g As Graphic, gg As Graphic, vv As Vertex
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    MsgBox "Distance from the origin is " + Str(g.GetDistance(0, 0, 0, vv, gg))
    Set g = IMSIGX.ActiveDrawing.Graphics.AddCircle(vv.X, vv.Y, vv.Z)
End Sub
Public Sub TSet() '  Setting text to new value FAILS
    Dim g As Graphic, gg As Graphic, vv As Vertex
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    If g.Type = "TEXT" Then
        g.TextSet "New Text"
    Else
        MsgBox "Graphic is not of type TEXT"
    End If
End Sub
Public Sub XForm() ' Selector is not reset.  The graphic is not drawn. No UNDO.
    Dim m As New Matrix
    Dim g As Graphic, gg As Graphic, vv As Vertex
    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one
    m.Rotate 0, 0, 1, 3.1415926 / 6#, 0, 0, 0
    g.Transform m
End Sub


Examples - Graphic Methods Macro - modGraphicCollections.bas

modGraphicCollections.bas

Graphic Methods Macro Example

Attribute VB_Name = "modGraphicCollections"
Sub OwnershipEx1()
    Dim gr As Graphic

    'Create standalone graphic
    ActiveDrawing.Graphics.Clear
    Debug.Print "Creating standalone graphic"
    Set gr = New Graphic
    'Zero graphics in drawing
    Debug.Print "Now " & ActiveDrawing.Graphics.Count & " graphics in drawing"
    'Parent is IApplication
    Debug.Print "Parent type: " & TypeName(gr.Parent)
    'Graphic is NOT in drawing -- it's standalone
    Debug.Print "Graphic in drawing? " & (Not gr.Drawing Is Nothing)
    'Graphic will be destroyed
    Set gr = Nothing
    'Still zero graphics in drawing
    Debug.Print "Now " & ActiveDrawing.Graphics.Count & " graphics in drawing"
End Sub

Sub OwnershipEx2()
    Dim gr As Graphic

    'Create owned graphic
    ActiveDrawing.Graphics.Clear
    Debug.Print "Adding graphic"
    Set gr = ActiveDrawing.Graphics.Add
    'One graphic in drawing now
    Debug.Print "Now " & ActiveDrawing.Graphics.Count & " graphics in drawing"
    'Parent is IGraphic -- bug?
    Debug.Print "Parent type: " & TypeName(gr.Parent)
    'Graphic is in drawing
    Debug.Print "Graphic in drawing? " & (Not gr.Drawing Is Nothing)
    'Graphic will NOT be destroyed -- we just lost a reference to it
    Set gr = Nothing
    'Still one graphic in drawing
    Debug.Print "Now " & ActiveDrawing.Graphics.Count & " graphics in drawing"
End Sub

Sub OwnershipEx3()
    Dim gr As Graphic

    'Create owned graphic
    ActiveDrawing.Graphics.Clear
    Debug.Print "Adding graphic"
    Set gr = ActiveDrawing.Graphics.Add
    'One graphic in drawing now
    Debug.Print "Now " & ActiveDrawing.Graphics.Count & " graphics in drawing"
    'Parent is IGraphic -- bug?
    Debug.Print "Parent type: " & TypeName(gr.Parent)
    'Graphic is in drawing
    Debug.Print "Graphic in drawing? " & (Not gr.Drawing Is Nothing)
    'Delete owned graphic
    Debug.Print "Deleting graphic"
    gr.Delete
    Set gr = Nothing
    'Zero graphics in drawing now
    Debug.Print "Now " & ActiveDrawing.Graphics.Count & " graphics in drawing"
End Sub

Sub OwnershipEx4()
    Dim gr As Graphic
    Dim i As Integer

    'Create owned graphic
    ActiveDrawing.Graphics.Clear
    Debug.Print "Adding graphic"
    Set gr = ActiveDrawing.Graphics.Add
    'One graphic in drawing now
    Debug.Print "Now " & ActiveDrawing.Graphics.Count & " graphics in drawing"
    'Parent is IGraphic -- bug?
    Debug.Print "Parent type: " & TypeName(gr.Parent)
    'Graphic is in drawing
    Debug.Print "Graphic in drawing? " & (Not gr.Drawing Is Nothing)
    'Get it's index for later and release our reference
    i = gr.Index
    Set gr = Nothing

    'Remove graphic from collection -- make it standalone
    Debug.Print "Removing graphic from collection"
    Set gr = ActiveDrawing.Graphics.Remove(i)
    'Zero graphics in drawing now
    Debug.Print "Now " & ActiveDrawing.Graphics.Count & " graphics in drawing"
    'Parent is IGraphic -- bug?
    Debug.Print "Parent type: " & TypeName(gr.Parent)
    'Graphic is in drawing
    Debug.Print "Graphic in drawing? " & (Not gr.Drawing Is Nothing)
    'Release (and destroy) standalone
    Set gr = Nothing
End Sub


Examples - Graphic Methods Macro - mView.bas

mView.bas

Graphic Methods Macro Example

Attribute VB_Name = "mView"
Public Sub ZoomExt()
    Dim v As View
    Set v = IMSIGX.ActiveDrawing.Views(0)
    MsgBox "About to zoom to extents..."
    v.ZoomToExtents
End Sub
Public Sub Named1() ' what is a view's name?  If I change the view to a named, its name is not showing
    Dim v As View, nv As NamedView
    Set nv = IMSIGX.ActiveDrawing.NamedViews(0)
    MsgBox "The first named view is '" + nv.Name + "'" + Chr(10) + "Current is '" + IMSIGX.ActiveDrawing.ActiveView.Name + "'"
End Sub
Public Sub Gettype()
    Dim g As Graphic
    Set g = IMSIGX.ActiveDrawing.Selection(0)
    If g.TypeByValue = imsiGroup Then
        MsgBox "It's a group"
    End If
    MsgBox "Type is " + Str(g.TypeByValue) + " or " + g.Type
End Sub
Public Sub CamLookAt()
    Dim c As Camera
    Set c = IMSIGX.ActiveDrawing.Views(0).Camera
    Dim v As Vertex
    Set v = c.LookAt
    MsgBox "Camera is looking at " + Str(v.X) + ", " + Str(v.Y) + ", " + Str(v.Z)
End Sub
Public Sub FlyAround() ' Probably OK, but I don't understand how the location,
                       ' direction, lookat, and upvector correlate.
    Dim c As Camera
    Dim v As New Vertex, up As New Vertex, la As New Vertex
    Dim b As BoundingBox
    Set b = IMSIGX.ActiveDrawing.Graphics.CalcBoundingBox
    xs# = b.Max.X - b.Min.X: ys# = b.Max.Y - b.Min.Y
    diag = Sqr(xs# * xs# + ys# * ys#)
    up.X = 0: up.Y = 0: up.Z = 1
    Set c = ActiveDrawing.Views(0).Camera
    c.Perspective = 1
    la.X = (b.Min.X + b.Max.X) / 2
    la.Y = (b.Min.Y + b.Max.Y) / 2
    la.Z = 0
    c.Location = b.Max
    Pi# = Atn(1) * 4
    k = 50
    For i = 0 To k
        v.X = diag * Cos(2 * i * Pi / k)
        v.Y = diag * Sin(2 * i * Pi / k)
        If xs# > ys# Then
            v.Z = xs#
        Else
            v.Z = ys#
        End If
        c.up = up            ' this seems necessary because LookAt changes it and then depends on it
        c.Location = v       ' or maybe it's the Location does that dance with the Up vector...
        c.LookAt = la
        IMSIGX.ActiveDrawing.ActiveView.Refresh
        MsgBox "push me..."
    Next i
End Sub


Examples - Nut Macro - frmNuts.frm

frmNuts.frm

Nut Macro Example

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmNuts
   Caption         =   "Nut Inserter"
   ClientHeight    =   2415
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4305
   OleObjectBlob   =   "frmNuts.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "frmNuts"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CommandButton1_Click()
    Me.Hide
End Sub


Examples - Nut Macro - modNuts.bas

modNuts.bas

Nut Macro Example

Attribute VB_Name = "modNuts"
' This sample creates some types of Nuts
'DBAPI constants
Const gkGraphic = 11
Const gkGroup = 7
Const gkArc = 2
Const gkText = 6
Const gfCosmetic = 128&

'Useful math constants
Const Pi# = 3.14159265
' Hex Nut  Hex Nut  Hex Nut  Hex Nut  Hex Nut  Hex Nut  Hex Nut
' Hex Nut  Hex Nut  Hex Nut  Hex Nut  Hex Nut  Hex Nut  Hex Nut

Public Sub HEXNUT()

Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim Gr As Graphic
Dim grfChild As Graphic
    Set App = IMSIGX.Application
    Set ActDr = App.ActiveDrawing
    Set Grs = ActDr.Graphics
    Set Gr = Grs.Add(gkGroup)

Dim X0#, Y0#, X1#, Y1#, t#
Dim D#, L#, E#, F#, s#, del#, dd#
Dim W#, H#

    X0# = 2#
    Y0# = 2#
    frmNuts.Image1.Visible = True
    frmNuts.Image2.Visible = False
    frmNuts.Image3.Visible = False
    frmNuts.Show
    dd = CDbl(frmNuts.TextBox1.Text)
    D# = 1.8 * dd#
    L# = 0.875 * dd#
    E# = 0.8 * L#
    F# = D# / 4#
    s# = (L# - E#) / 2#
' adds child graphics to the graphic - Gr
    Set grfChild = Gr.Graphics.Add(gkGraphic)
            ' add vertices to the child
    With grfChild.Vertices
        .Add X0#, Y0# - D# / 2# + s#, 0
        .Add X0#, Y0# + D# / 2# - s#, 0, True
        .Add X0# + s#, Y0# + D# / 2#, 0, True
        .Add X0# + L# - s#, Y0# + D# / 2#, 0, True

        .Add X0# + L#, Y0# + D# / 2# - s#, 0
        .Add X0# + L#, Y0# - D# / 2# + s#, 0, True
        .Add X0# + L# - s#, Y0# - D# / 2#, 0, True
        .Add X0# + s#, Y0# - D# / 2#, 0, True
        .Add X0#, Y0# - D# / 2# + s#, 0, True
    End With

    Set grfChild = Gr.Graphics.Add(gkGraphic)
            ' add vertices to the child
    With grfChild.Vertices
        .Add X0# + s#, Y0# + F#, 0
        .Add X0# + L# - s#, Y0# + F#, 0, True
    End With

    Set grfChild = Gr.Graphics.Add(gkGraphic)
            ' add vertices to the child
    With grfChild.Vertices
        .Add X0# + s#, Y0# - F#, 0
        .Add X0# + L# - s#, Y0# - F#, 0, True
    End With
    Set grfChild = Gr.Graphics.AddArcTriplePoint(X0# + s#, Y0# - D# / 2#, 0, X0#, Y0# - (D# / 2# + F#) / 2#, 0, X0# + s#, Y0# - F#, 0)
    Set grfChild = Gr.Graphics.AddArcTriplePoint(X0# + s#, Y0# - F#, 0, X0#, Y0#, 0, X0# + s#, Y0# + F#, 0)
    Set grfChild = Gr.Graphics.AddArcTriplePoint(X0# + s#, Y0# + F#, 0, X0#, Y0# + (D# / 2# + F#) / 2#, 0, X0# + s#, Y0# + D# / 2#, 0)
    Set grfChild = Gr.Graphics.AddArcTriplePoint(X0# + L# - s#, Y0# - D# / 2#, 0, X0# + L#, Y0# - (D# / 2# + F#) / 2#, 0, X0# + L# - s#, Y0# - F#, 0)
    Set grfChild = Gr.Graphics.AddArcTriplePoint(X0# + L# - s#, Y0# - F#, 0, X0# + L#, Y0#, 0, X0# + L# - s#, Y0# + F#, 0)
    Set grfChild = Gr.Graphics.AddArcTriplePoint(X0# + L# - s#, Y0# + F#, 0, X0# + L#, Y0# + (D# / 2# + F#) / 2#, 0, X0# + L# - s#, Y0# + D# / 2#, 0)
    ActDr.Views(0).Refresh
End Sub

' Low Crown Nut  Low Crown Nut  Low Crown Nut  Low Crown Nut
' Low Crown Nut  Low Crown Nut  Low Crown Nut  Low Crown Nut

Public Sub LOWCROWNNUT()

Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim Gr As Graphic
Dim grfChild As Graphic
    Set App = IMSIGX.Application
    Set ActDr = App.ActiveDrawing
    Set Grs = ActDr.Graphics
    Set Gr = Grs.Add(gkGroup)

    'Add child Graphics
Dim X0#, Y0#, X1#, Y1#, t#
Dim D#, L#, E#, F#, s#, del#, dd#
Dim W#, H#, a#

    X0# = 2#
    Y0# = 2#
    frmNuts.Image1.Visible = False
    frmNuts.Image2.Visible = True
    frmNuts.Image3.Visible = False
    frmNuts.Show
    dd = CDbl(frmNuts.TextBox1.Text)

    D# = 1.66 * dd#
    L# = 0.72 * dd#
    E# = 0.8 * L#
    F# = D# / 4#
    s# = (L# - E#) / 2#
    H# = 1.55 * dd#
    a# = 1.41 * dd#

    '1
     Set grfChild = Gr.Graphics.AddLineSingle(X0, Y0 - D / 2# + s, 0, X0, Y0 + D / 2# - s, 0)
    '2
     Set grfChild = Gr.Graphics.AddLineSingle(X0, Y0 + D / 2# - s, 0, X0 + s, Y0 + D / 2#, 0)
    '3
     Set grfChild = Gr.Graphics.AddLineSingle(X0 + s, Y0 + D / 2#, 0, X0 + L - s, Y0 + D / 2#, 0)
    '4
     Set grfChild = Gr.Graphics.AddLineSingle(X0 + L - s, Y0 + D / 2#, 0, X0 + L, Y0 + D / 2# - s, 0)
    '5
     'Set grfChild = grfThis.Graphics.AddLineSingle(X0 + L, Y0 + D / 2# - S, 0, X0 + L, Y0 - D / 2# + S, 0)
     Set grfChild = Gr.Graphics.AddArcEllipticalFixedRatio(X0 + L, Y0, 0#, X0 + L, Y0 + a / 2#, 0#, (H - L) / (a / 2#), -Pi / 2#, Pi / 2#)
    '6
     Set grfChild = Gr.Graphics.AddLineSingle(X0 + L, Y0 - D / 2# + s, 0, X0 + L - s, Y0 - D / 2#, 0)
    '7
     Set grfChild = Gr.Graphics.AddLineSingle(X0 + L - s, Y0 - D / 2#, 0, X0 + s, Y0 - D / 2#, 0)
    '8
     Set grfChild = Gr.Graphics.AddLineSingle(X0 + s, Y0 - D / 2#, 0, X0, Y0 - D / 2# + s, 0)
    '9
     Set grfChild = Gr.Graphics.AddLineSingle(X0 + s, Y0 + F, 0, X0 + L - s, Y0 + F, 0)
    '9
     Set grfChild = Gr.Graphics.AddLineSingle(X0 + s, Y0 - F, 0, X0 + L - s, Y0 - F, 0)

     Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + s, Y0 - D / 2#, 0, X0, Y0 - (D / 2# + F) / 2#, 0, X0 + s, Y0 - F, 0)
     Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + s, Y0 - F, 0, X0, Y0, 0, X0 + s, Y0 + F, 0)
     Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + s, Y0 + F, 0, X0, Y0 + (D / 2# + F) / 2#, 0, X0 + s, Y0 + D / 2#, 0)
     Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + L - s, Y0 - D / 2#, 0, X0 + L, Y0 - (D / 2# + F) / 2#, 0, X0 + L - s, Y0 - F, 0)
     Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + L - s, Y0 - F, 0, X0 + L, Y0, 0, X0 + L - s, Y0 + F, 0)
     Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + L - s, Y0 + F, 0, X0 + L, Y0 + (D / 2# + F) / 2#, 0, X0 + L - s, Y0 + D / 2#, 0)
    ActDr.Views(0).Refresh
End Sub

' Hex Slotted Nut  Hex Slotted Nut  Hex Slotted Nut  Hex Slotted Nut
' Hex Slotted Nut  Hex Slotted Nut  Hex Slotted Nut  Hex Slotted Nut

Public Sub HEXSLOTTEDNUT()
Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim Gr As Graphic
Dim grfChild As Graphic
    Set App = IMSIGX.Application
    Set ActDr = App.ActiveDrawing
    Set Grs = ActDr.Graphics
    Set Gr = Grs.Add(gkGroup)

    'Add child Graphics
Dim X0#, Y0#, t#
Dim D#, L#, E#, F#, s#, del#, dd#
Dim W#, H#, J#

    X0# = 2#
    Y0# = 2#

    frmNuts.Image1.Visible = False
    frmNuts.Image2.Visible = False
    frmNuts.Image3.Visible = True
    frmNuts.Show
    dd = CDbl(frmNuts.TextBox1.Text)

    D# = 1.8 * dd#
    L# = 0.875 * dd#
    E# = 0.8 * L#
    F# = D# / 4#
    s# = (L# - E#) / 2#
    J# = 0.3 * dd#
    H# = 0.3 * dd#

'1
 Set grfChild = Gr.Graphics.AddLineSingle(X0, Y0 - D / 2# + s, 0, X0, Y0 + D / 2# - s, 0)
'2
 Set grfChild = Gr.Graphics.AddLineSingle(X0, Y0 + D / 2# - s, 0, X0 + s, Y0 + D / 2#, 0)
'3
 Set grfChild = Gr.Graphics.AddLineSingle(X0, Y0 - D / 2# + s, 0, X0 + s, Y0 - D / 2#, 0)
'4
 Set grfChild = Gr.Graphics.AddLineSingle(X0 + s, Y0 + D / 2#, 0, X0 + L - s, Y0 + D / 2#, 0)
'5
 Set grfChild = Gr.Graphics.AddLineSingle(X0 + s, Y0 - D / 2#, 0, X0 + L - s, Y0 - D / 2#, 0)
'6
 Set grfChild = Gr.Graphics.AddLineSingle(X0 + L - s, Y0 + D / 2#, 0, X0 + L, Y0 + D / 2# - s, 0)
7
 Set grfChild = Gr.Graphics.AddLineSingle(X0 + L - s, Y0 - D / 2#, 0, X0 + L, Y0 - D / 2# + s, 0)
'8
 Set grfChild = Gr.Graphics.AddLineSingle(X0 + L, Y0 + D / 2# - s, 0, X0 + L, Y0 + J / 2#, 0)
'9
 Set grfChild = Gr.Graphics.AddLineSingle(X0 + L, Y0 - D / 2# + s, 0, X0 + L, Y0 - J / 2#, 0)
'10
 Set grfChild = Gr.Graphics.AddLineSingle(X0 + s, Y0 + F, 0, X0 + L - s, Y0 + F, 0)
'11
 Set grfChild = Gr.Graphics.AddLineSingle(X0 + s, Y0 - F, 0, X0 + L - s, Y0 - F, 0)
'12
 Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + s, Y0 + D / 2#, 0, X0, Y0 + (D / 2# + F) / 2#, 0, X0 + s, Y0 + F, 0)
'13
 Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + s, Y0 - D / 2#, 0, X0, Y0 - (D / 2# + F) / 2#, 0, X0 + s, Y0 - F, 0)
'14
 Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + s, Y0 + F, 0, X0, Y0, 0, X0 + s, Y0 - F, 0)
'15
 Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + L - s, Y0 + D / 2#, 0, X0 + L, Y0 + (D / 2 + F) / 2#, 0, X0 + L - s, Y0 + F, 0)
'16
 Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + L - s, Y0 - D / 2#, 0, X0 + L, Y0 - (D / 2# + F) / 2#, 0, X0 + L - s, Y0 - F, 0)
'17
 Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + L - s, Y0 + F, 0, X0 + L - 0.3 * s, Y0 + (J / 2# + F) / 2#, 0, X0 + L, Y0 + J / 2#, 0)
'18
 Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + L - s, Y0 - F, 0, X0 + L - 0.3 * s, Y0 - (J / 2# + F) / 2#, 0, X0 + L, Y0 - J / 2#, 0)
'19
 Set grfChild = Gr.Graphics.AddLineSingle(X0 + L, Y0 + 0.375 * D + J / 4#, 0, X0 + L - H + J / 4#, Y0 + 0.375 * D + J / 4#, 0)
'20
 Set grfChild = Gr.Graphics.AddLineSingle(X0 + L, Y0 + 0.375 * D - J / 4#, 0, X0 + L - H + J / 4#, Y0 + 0.375 * D - J / 4#, 0)
'21
 Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + L - H + J / 4#, Y0 + 0.375 * D + J / 4#, 0, X0 + L - H, Y0 + 0.375 * D, 0, X0 + L - H + J / 4#, Y0 + 0.375 * D - J / 4#, 0)
'22
 Set grfChild = Gr.Graphics.AddLineSingle(X0 + L, Y0 - 0.375 * D + J / 4#, 0, X0 + L - H + J / 4#, Y0 - 0.375 * D + J / 4#, 0)
'23
 Set grfChild = Gr.Graphics.AddLineSingle(X0 + L, Y0 - 0.375 * D - J / 4#, 0, X0 + L - H + J / 4#, Y0 - 0.375 * D - J / 4#, 0)
'24
 Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + L - H + J / 4#, Y0 - 0.375 * D + J / 4#, 0, X0 + L - H, Y0 - 0.375 * D, 0, X0 + L - H + J / 4#, Y0 - 0.375 * D - J / 4#, 0)
'25
 Set grfChild = Gr.Graphics.AddLineSingle(X0 + L, Y0 + J / 2#, 0, X0 + L - H + J / 2#, Y0 + J / 2#, 0)
'26
 Set grfChild = Gr.Graphics.AddLineSingle(X0 + L, Y0 - J / 2#, 0, X0 + L - H + J / 2#, Y0 - J / 2#, 0)
'27
 Set grfChild = Gr.Graphics.AddArcTriplePoint(X0 + L - H + J / 2#, Y0 + J / 2#, 0, X0 + L - H, Y0, 0, X0 + L - H + J / 2#, Y0 - J / 2#, 0)
    ActDr.Views(0).Refresh

End Sub


Examples - Paper Space Macro - modPS.bas

modPS.bas

Paper Space Macro Example

Attribute VB_Name = "modPS"
Sub EnumPaperSpaces()
    On Error GoTo PSError
    Dim pss As GXMPSLib.PaperSpaces
    Dim ps As GXMPSLib.PaperSpace
    Dim grs As Graphics
    Dim gr As Graphic
    Dim props As Properties
    Dim prop As Property
    Dim dwg As Drawing
    Dim i, j As Integer
    Dim dumpfile As String

    Set dwg = ActiveDrawing
    Set pss = dwg
    Debug.Print pss.count & " PaperSpaces"
    On Error Resume Next

    'For Each does an infinite loop
    'For Each ps In pss
    For i = 0 To pss.count - 1
        Set ps = pss(i)
        Debug.Print "Name: " & ps.Name
        With ps.RelativeOrigin
            Debug.Print "RelativeOrigin: (" & .x & ", " & .y & ", " & .z & ")"
        End With

        Set grs = ps.Graphics
        Debug.Print grs.count & " Graphics"
        For Each gr In grs
            Debug.Print "Type: " & gr.Type
        Next

        dumpfile = "d:\" & ps.Name & "_props.txt"
        Open dumpfile For Output As #1

        ps.Activate
        Print #1, "Print Space Properties ----------"
        PrintPropertiesToFile ps.Properties
        Print #1, "Drawing Properties ----------"
        PrintPropertiesToFile ps.Properties

        Close #1

    Next
    Exit Sub

PSError:
    MsgBox "Error: " & Err.Description
End Sub

Sub EnumGraphicsInAllSpaces()
    On Error Resume Next
    Dim mode As Integer

    mode = ActiveDrawing.Properties("TileMode")
    ActiveDrawing.Properties("TileMode") = 1
    Debug.Print "Model Space"
    EnumGraphicsInCurrentSpace
    ActiveDrawing.Properties("TileMode") = 0
    Debug.Print "Paper Space"
    EnumGraphicsInCurrentSpace
    ActiveDrawing.Properties("TileMode") = mode
End Sub

Sub EnumGraphicsInCurrentSpace()
    On Error Resume Next
    Dim m As Matrix
    Dim i As Integer
    Dim gr As Graphic
    Dim grs As Graphics
    Set grs = ActiveDrawing.Graphics
    i = 0
    For Each gr In grs
        i = i + 1
        Debug.Print i
        Debug.Print gr.Type
        Set m = Nothing
        Set m = gr.UCS
        If Not m Is Nothing Then
            Debug.Print m
        Else
            Debug.Print "no UCS"
        End If
    Next
End Sub

Sub DumpDrawingPropertiesBothSpaces()
    On Error Resume Next
    Open "J:\dwgprops.txt" For Output As #1
    ActiveDrawing.Properties("TileMode") = 0
    Print #1, "Tile Mode 0 ---------------"
    DumpDrawingProperties
    ActiveDrawing.Properties("TileMode") = 1
    Print #1, "Tile Mode 1 ---------------"
    DumpDrawingProperties
    Close #1
End Sub

Sub DumpDrawingProperties()
    On Error Resume Next
    Dim i, count As Integer

    count = ActiveDrawing.Properties.count
    Print #1, count & " Properties:"
    Dim prop As Property
    i = 0
    For Each prop In ActiveDrawing.Properties
        i = i + 1
        Print #1, i
        DumpProperty prop
    Next
End Sub


Examples - Printing Macro - modPrint.bas

modPrint.bas

Printing Macro Example

Option Explicit

Sub PrintExample()
    Dim gxVw As View
    Dim oldScaleMode As Long

    Dim width As Long
    Dim height As Long

    Dim dx As Long
    Dim dz As Long

    oldScaleMode = Printer.ScaleMode
    Printer.ScaleMode = 3 ' pixels

    Set gxVw = gxDwg1.Views.Add(, Printer.hDC)
    gxVw.Update = False

    Printer.Print " " ' initialize printer

    width = Printer.ScaleWidth
    height = Printer.ScaleHeight

    dx = width * 0.05
    dy = height * 0.05

    gxVw.ScreenTop = dx
    gxVw.ScreenLeft = dy
    gxVw.ScreenHeight = height * 0.9
    gxVw.ScreenWidth = width * 0.9
    gxVw.CenterOnExtents = True
    gxVw.FixedAspectRatio = True
    gxVw.MappingMode = 1

    gxVw.ZoomToExtents

    Printer.Line (1, 1)-(width - 1, 1)
    Printer.Line (width - 1, 1)-(width - 1, height - 1)
    Printer.Line (width - 1, height - 1)-(1, height - 1)
    Printer.Line (1, height - 1)-(1, 1)

    Printer.Line (dx, dy)-(width - dx, dy)
    Printer.Line (width - dx, dy)-(width - dx, height - dy)
    Printer.Line (width - dx, height - dy)-(dx, height - dy)
    Printer.Line (dx, height - dy)-(dx, dy)

    Printer.EndDoc
    gxVw.Delete

    Printer.ScaleMode = oldScaleMode ' pixels
End Sub


Examples - Selection Property Macro - frmColorPalette.frm

frmColorPalette.frm

Selection Property Macro Example

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmColorPalette
   Caption         =   "Select Color"
   ClientHeight    =   1995
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   1890
   OleObjectBlob   =   "frmColorPalette.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "frmColorPalette"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub CommandButton1_Click()
    Me.Hide
End Sub

Private Sub Image1_Click()
    Color = Image1.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image10_Click()
    Color = Image10.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image11_Click()
    Color = Image11.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image12_Click()
    Color = Image12.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image13_Click()
    Color = Image13.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image14_Click()
    Color = Image14.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image15_Click()
    Color = Image15.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image16_Click()
    Color = Image16.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image17_Click()
    Color = Image17.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image18_Click()
    Color = Image18.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image19_Click()
    Color = Image19.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image2_Click()
    Color = Image2.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image20_Click()
    Color = Image20.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image21_Click()
    Color = Image2.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image22_Click()
    Color = Image22.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image23_Click()
    Color = Image23.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image24_Click()
    Color = Image24.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image25_Click()
    Color = Image25.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image26_Click()
    Color = Image26.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image27_Click()
    Color = Image27.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image28_Click()
    Color = Image28.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image29_Click()
    Color = Image29.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image3_Click()
    Color = Image3.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image30_Click()
    Color = Image30.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image31_Click()
    Color = Image31.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image32_Click()
    Color = Image32.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image33_Click()
    Color = Image33.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image34_Click()
    Color = Image34.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image35_Click()
    Color = Image35.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image36_Click()
    Color = Image36.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image37_Click()
    Color = Image37.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image38_Click()
    Color = Image38.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image39_Click()
    Color = Image39.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image4_Click()
    Color = Image4.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image40_Click()
    Color = Image40.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image41_Click()
    Color = Image41.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image42_Click()
    Color = Image42.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image43_Click()
    Color = Image43.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image44_Click()
    Color = Image44.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image45_Click()
    Color = Image45.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image46_Click()
    Color = Image46.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image47_Click()
    Color = Image47.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image48_Click()
    Color = Image48.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image5_Click()
    Color = Image5.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image6_Click()
    Color = Image6.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image7_Click()
    Color = Image7.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image8_Click()
    Color = Image8.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub

Private Sub Image9_Click()
    Color = Image9.BackColor
    GrSel.Properties.Item(frmPropSel.GrPropName.Text).Value = Color
    Vi.Refresh
End Sub


Examples - Selection Property Macro - frmPropSel.frm

frmPropSel.frm

Selection Property Macro Example

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmPropSel
   Caption         =   "UserForm1"
   ClientHeight    =   3030
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5310
   OleObjectBlob   =   "frmPropSel.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "frmPropSel"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CommandButton1_Click()
    If PropValue.Text <> "Absent for this Graphic" Then
        GrSel.Properties.Item(GrPropName.Text).Value = CVar(PropValue.Text)
        Vi.Refresh
    End If
End Sub

Private Sub GrPropName_Click()
    On Error GoTo ErrorHandler
    PropValue.Enabled = True
Dim PrValue As Variant
    PrValue = GrSel.Properties.Item(GrPropName.Text)
    PropValue.Text = CStr(PrValue)
    If VarType(PrValue) = 2 Then
        Label4.Caption = "Integer"
    End If
    If VarType(PrValue) = 3 Then
        Label4.Caption = "Long"
    End If
    If VarType(PrValue) = 5 Then
        Label4.Caption = "Double"
    End If
    If VarType(PrValue) = 8 Then
        Label4.Caption = "String"
    End If
    If VarType(PrValue) = 11 Then
        Label4.Caption = "Boolean"
    End If
    If VarType(PrValue) = 12 Then
        Label4.Caption = "Variant"
    End If
    If VarType(PrValue) = 8192 Then
        Label4.Caption = "Array"
    End If
    If Right(GrPropName.Text, 5) = "Color" Then
        Color = PrValue
        frmColorPalette.Show
        PropValue.Text = CStr(Color)
    End If
    PenStyle.Visible = False
    If GrPropName.Text = "PenStyle" Then
        PenStyle.Visible = True
        PenStyle.Clear
        PenStyle.AddItem ("CONTINUOUS")
        PenStyle.AddItem ("Border")
        PenStyle.AddItem ("Center")
        PenStyle.AddItem ("DashDot")
        PenStyle.AddItem ("Dashed")
        PenStyle.AddItem ("Divide")
        PenStyle.AddItem ("Dot")
        PenStyle.AddItem ("Hidden")
        PenStyle.AddItem ("Phantom")
    End If
    If GrPropName.Text = "BrushStyle" Then
        PenStyle.Visible = True
        PenStyle.Clear
        PenStyle.AddItem ("None")
        PenStyle.AddItem ("Solid")
        PenStyle.AddItem ("L45")
        PenStyle.AddItem ("Gostak")
        PenStyle.AddItem ("IUS")
        PenStyle.AddItem ("B816")
        PenStyle.AddItem ("B816C")
        PenStyle.AddItem ("ARB88")
        PenStyle.AddItem ("BRELM")

        PenStyle.AddItem ("BRSTD")
        PenStyle.AddItem ("CONC")
        PenStyle.AddItem ("HBONE")
        PenStyle.AddItem ("PARK1")
        PenStyle.AddItem ("ANGLE")
        PenStyle.AddItem ("ANSI31")
        PenStyle.AddItem ("ANSI32")
        PenStyle.AddItem ("ANSI33")
        PenStyle.AddItem ("ANSI34")

        PenStyle.AddItem ("ANSI35")
        PenStyle.AddItem ("ANSI36")
        PenStyle.AddItem ("ANSI37")
        PenStyle.AddItem ("ANSI38")
        PenStyle.AddItem ("BRICK_8X16")
        PenStyle.AddItem ("BRICK_8X16C")
        PenStyle.AddItem ("BRICK_8X8")
        PenStyle.AddItem ("BR_ENGLISH")
        PenStyle.AddItem ("BR_STRECHER")

        PenStyle.AddItem ("BRICK")
        PenStyle.AddItem ("BRICK_STONE")
        PenStyle.AddItem ("CONCRETE_1")
        PenStyle.AddItem ("CONCRETE_2")
        PenStyle.AddItem ("HERRINGBONE1")
        PenStyle.AddItem ("HERRINGBONE2")
        PenStyle.AddItem ("PARQUET1")
        PenStyle.AddItem ("PARQUETTE1")
        PenStyle.AddItem ("SHINGLE")

        PenStyle.AddItem ("SHAKER")
        PenStyle.AddItem ("SAND")
        PenStyle.AddItem ("BOX")
        PenStyle.AddItem ("BRASS")
        PenStyle.AddItem ("CLAY")
        PenStyle.AddItem ("CORK")
        PenStyle.AddItem ("CROSS")
        PenStyle.AddItem ("DASH")
        PenStyle.AddItem ("ROCK_LAYER")

        PenStyle.AddItem ("DOTS")
        PenStyle.AddItem ("EARTH")
        PenStyle.AddItem ("EACHER")
        PenStyle.AddItem ("FLEX")
        PenStyle.AddItem ("GRASS")
        PenStyle.AddItem ("GRATE")
        PenStyle.AddItem ("HEXAGONS")
        PenStyle.AddItem ("HONEYCOMB")
        PenStyle.AddItem ("HOUNDSTOOTH")
    End If

    Exit Sub
ErrorHandler:
    PropValue.Text = "Absent for this Graphic"
    PropValue.Enabled = False
End Sub

Private Sub PenStyle_Click()
    PropValue.Text = PenStyle.Text
    GrSel.Properties.Item(GrPropName.Text).Value = CVar(PropValue.Text)
    Vi.Refresh

End Sub


Examples - Selection Property Macro - modPropSel.bas

modPropSel.bas

Selection Property Macro Example

Attribute VB_Name = "modPropSel"
' This Sample allows to select some object of the activeDrawing
' gets its properties and changes any property

Public GrSel As Graphic
Public Vi As View
Public Color As Long

Public Sub PickProp()

Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim GrsSelected As Selection
Dim Vis As Views
    Set App = IMSIGX.Application 'returns the application - TurboCAD
    Set ActDr = App.ActiveDrawing ' returns active dtawing
    Set Grs = ActDr.Graphics ' returns graphics collection
    Set Vis = ActDr.Views 'returns Views collection
    Set Vi = Vis.Item(0) ' returns some view
Dim xClick#, yClick#
Dim PicRes As PickResult
Dim PicEnt As PickEntry
MsgBox ("Select graphic")
    Vi.GetMouseClick xClick, yClick 'this function gets coordinates of the mouse click
    'Vi.PickPoint(...) - Pick Graphic objects at a point in view coordinate system.
    Set PicRes = Vi.PickPoint(xClick, yClick, 0.1, False, True, True, True, True, False)
    If PicRes.Count = 0 Then Exit Sub

Dim SelCount As Long
Dim ItemSel As Long
Dim NameSel As String
Dim PropCount As Long
Dim ItemProp As Long
Dim NameProp As String
Dim ValueProp As Variant

    Set GrSel = PicRes.Item(0).Graphic ' gets selected graphic
    PropCount = GrSel.Properties.Count ' defines the count of the properties for selected graphic
    For ItemProp = 0 To PropCount - 1
        NameProp = GrSel.Properties.Item(ItemProp).Name
        frmPropSel.GrPropName.AddItem (NameProp)
    Next ItemProp
    frmPropSel.GrPropName.ListIndex = 1
    Vi.Refresh

    frmPropSel.Show

End Sub


Examples - Rendering Macro - frmRender.frm

frmRender.frm

Rendering Macro Example

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmRender
   Caption         =   "Render Manager"
   ClientHeight    =   4380
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4440
   OleObjectBlob   =   "frmRender.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "frmRender"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cm_RunRender_Click()
    Dim s As String
    s = ListView1.SelectedItem.Text
    Set R = Nothing
    Set R = Rs.Item(s)

    R.DefaultMode = RenderModeFromName(ListView2.SelectedItem.Text)
    R.Run Dr.ActiveView
End Sub

Private Sub cm_close_Click()
    Unload Me
End Sub

Private Sub cm_EndRender_Click()
    Set Rv = Dr.ActiveView.RenderView
    If Rv.IsRenderRunned Then
        Rv.EndRender
    Else
        MsgBox "There is no render runned in the active view !"
    End If
End Sub

Private Sub UserForm_Initialize()
    Set App = IMSIGX.Application
    Set Rs = App.Renders
    Set Dr = App.ActiveDrawing
    Set V = Dr.ActiveView
    Call FillTreeView
End Sub

Function RenderModeFromName(ByVal RenderModeName As String) As ImsiRenderMode
    If (RenderModeName = "Flat") Then
        RenderModeFromName = imsiRenderModeFlat
        Exit Function
    ElseIf (RenderModeName = "Gouraud") Then
        RenderModeFromName = imsiRenderModeGouraud
        Exit Function
    ElseIf (RenderModeName = "Phong") Then
        RenderModeFromName = imsiRenderModePhong
        Exit Function
    ElseIf (RenderModeName = "Preview") Then
        RenderModeFromName = imsiRenderModePreview
        Exit Function
    ElseIf (RenderModeName = "Full") Then
        RenderModeFromName = imsiRenderModeFull
        Exit Function
    ElseIf (RenderModeName = "Raytrace Preview") Then
        RenderModeFromName = imsiRenderModeRtPreview
        Exit Function
    ElseIf (RenderModeName = "Raytrace Full") Then
        RenderModeFromName = imsiRenderModeRtFull
        Exit Function
    ElseIf (RenderModeName = "Wireframe") Then
        RenderModeFromName = imsiRenderModeWireFrame
        Exit Function
    ElseIf (RenderModeName = "Hidden Line") Then
        RenderModeFromName = imsiRenderModeHiddenLine
        Exit Function
    ElseIf (RenderModeName = "Radiosity") Then
        RenderModeFromName = imsiRenderModeRadiosity
        Exit Function
    End If
End Function

Private Function FillTreeView()
    Dim n As Long
    Dim N1 As node
    Dim RenderModes As Variant
    Dim ExRenderModes As Variant
    Dim res As Boolean
    Dim m As Long
    For n = 0 To Rs.count - 1
            Set N1 = TreeView1.Nodes.Add(, , , Rs(n).Name)
            Set R = Rs.Item(n)
            RenderModes = R.modes
            For m = 0 To UBound(RenderModes)
                TreeView1.Nodes.Add N1, tvwChild, , RenderModes(m)
            Next m
            N1.Expanded = True
    Next n

End Function

Private Sub TreeView1_NodeClick(ByVal node As node)
    Dim bRRunned As Boolean
    If Dr.ActiveView.SpaceMode = imsiPaperSpace Then
        MsgBox "Can't run Render in paper space. Switch to model space and try again. "
        Exit Sub
    End If
    If node.Children <> 0 Then Exit Sub
    Set R = Rs.Item(node.Parent.Text)
    R.DefaultMode = RenderModeFromName(node.Text)
    R.Run Dr.ActiveView
End Sub


Examples - Rendering Macro - modRender.bas

modRender.bas

Rendering Macro Example

Attribute VB_Name = "modRender"
Option Explicit

Global App As Application
Global Dr As Drawing
Global V As View
Global Rs As Renders
Global R As Render
Global Rv As RenderView
Global CurRenderMode As ImsiRenderMode

Sub RenderManager()
    frmRender.Show vbModal
    Call CleanUp
End Sub

Private Sub CleanUp()
    Set Rv = Nothing
    Set R = Nothing
    Set Rs = Nothing
    Set V = Nothing
    Set Dr = Nothing
    Set App = Nothing
End Sub

Public Sub RenderEx1()
    Dim i%, j%, rcount%
    Dim rnd As Render
    Dim rmodes As Variant
    With Application.Renders
        rcount = .count
        For i = 0 To rcount - 1
            Set rnd = .Item(i)
            Debug.Print "Render: " & rnd.Name
            rmodes = rnd.modes
            If VarType(rmodes) <> vbEmpty Then
                For j = 0 To UBound(rmodes)
                    Debug.Print " Mode: " & rmodes(j)
                Next
            Else
                Debug.Print " No modes"
            End If
            rmodes = rnd.RadExtendedModes
            If VarType(rmodes) <> vbEmpty Then
                For j = 0 To UBound(rmodes)
                    Debug.Print " RadExtendedMode: " & rmodes(j)
                Next
            Else
                Debug.Print " No radiosity modes"
            End If
        Next
    End With
End Sub

Public Sub RenderEx2()
    Dim rnd As Render
    Dim vw As View
    Dim opic As IPicture

    'Set up the rendering type
    Set rnd = Application.Renders("OpenGL")
    rnd.DefaultMode = imsiRenderModeGouraud

    'Set up the camera
    Set vw = ActiveDrawing.ActiveView
    vw.Camera.Perspective = True

    'Run the rendering process
    Set opic = rnd.Run(vw)
    If Not opic Is Nothing Then
        SavePicture opic, "D:\Test.bmp"
    End If
End Sub


Examples - Rounded Rectangle Macro - frmRRect.frm

frmRRect.frm

Rounded Rectangle Macro Example

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmRRect
   Caption         =   "UserForm1"
   ClientHeight    =   6195
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8010
   OleObjectBlob   =   "frmRRect.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "frmRRect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CmdOk_Click()
    Me.Hide
End Sub


Examples - Rounded Rectangle Macro - modRRect.bas

modRRect.bas

Rounded Rectangle Macro Example

Attribute VB_Name = "modRRect"
Public Sub RoundRectangle()
' Create 2D-RoundRectangle with holes
    Dim App As Application
    Dim ActDr As Drawing
    Dim Grs As Graphics
    Dim Gr As Graphic
    Dim a#, b#, R#, r1#
    Dim X0#, y0#
    Dim Pi#
    Pi = 3.14159
    X0 = 5
    y0 = 5
    frmRRect.Show
    a = CDbl(frmRRect.TextBox1.Text)
    b = CDbl(frmRRect.TextBox2.Text)
    R = CDbl(frmRRect.TextBox3.Text)
    r1 = CDbl(frmRRect.TextBox4.Text) / 2
    If R <= 0 Then R = 0
    If r1 > R Then r1 = 0
    Set App = IMSIGX.Application    'Returns an Application object - TurboCAD
    Set ActDr = App.ActiveDrawing   'Returns the active Drawing object
    Set Grs = ActDr.Graphics    'Returns the Graphics collection for active Drawing object
    If R = 0 Then
        'Creates and adds a rectangle to the Graphics collection.
        Set Gr = Grs.AddLineRectangle(X0 - a / 2, y0 - b / 2, 0, X0 + a / 2, y0 + b / 2, 0)
        Gr.Properties("PenWidth") = 0.03 'Changes the Graphic Property - "PenWidth"
    Else
        ' Add Line segments
        Set Gr = Grs.AddLineSingle(X0 - a / 2 + R, y0 - b / 2, 0, X0 + a / 2 - R, y0 - b / 2, 0)
        Gr.Properties("PenWidth") = 0.03
        Set Gr = Grs.AddLineSingle(X0 + a / 2, y0 - b / 2 + R, 0, X0 + a / 2, y0 + b / 2 - R, 0)
        Gr.Properties("PenWidth") = 0.03
        Set Gr = Grs.AddLineSingle(X0 - a / 2 + R, y0 + b / 2, 0, X0 + a / 2 - R, y0 + b / 2, 0)
        Gr.Properties("PenWidth") = 0.03
        Set Gr = Grs.AddLineSingle(X0 - a / 2, y0 - b / 2 + R, 0, X0 - a / 2, y0 + b / 2 - R, 0)
        Gr.Properties("PenWidth") = 0.03
        ' Add Arcs
        Set Gr = Grs.AddArcCenterAndPoint(X0 - a / 2 + R, y0 - b / 2 + R, 0, X0 - a / 2 + R, y0 - b / 2, 0, Pi, 3 * Pi / 2)
        Gr.Properties("PenWidth") = 0.03
        Set Gr = Grs.AddArcCenterAndPoint(X0 + a / 2 - R, y0 - b / 2 + R, 0, X0 + a / 2 - R, y0 - b / 2, 0, 3 * Pi / 2, 2 * Pi)
        Gr.Properties("PenWidth") = 0.03
        Set Gr = Grs.AddArcCenterAndPoint(X0 + a / 2 - R, y0 + b / 2 - R, 0, X0 + a / 2 - R, y0 + b / 2, 0, 0, Pi / 2)
        Gr.Properties("PenWidth") = 0.03
        Set Gr = Grs.AddArcCenterAndPoint(X0 - a / 2 + R, y0 + b / 2 - R, 0, X0 - a / 2 + R, y0 + b / 2, 0, Pi / 2, Pi)
        Gr.Properties("PenWidth") = 0.03
        ' Add Circles
        If r1 > 0 Then
            Set Gr = Grs.AddCircleCenterAndPoint(X0 - a / 2 + R, y0 - b / 2 + R, 0, X0 - a / 2 + R, y0 - b / 2 + R + r1, 0)
            Gr.Properties("PenWidth") = 0.03
            Gr.Properties("PenColor") = RGB(0, 255, 0)
            Set Gr = Grs.AddCircleCenterAndPoint(X0 + a / 2 - R, y0 - b / 2 + R, 0, X0 + a / 2 - R, y0 - b / 2 + R + r1, 0)
            Gr.Properties("PenWidth") = 0.03
            Gr.Properties("PenColor") = RGB(0, 255, 0)
            Set Gr = Grs.AddCircleCenterAndPoint(X0 + a / 2 - R, y0 + b / 2 - R, 0, X0 + a / 2 - R, y0 + b / 2 - R + r1, 0)
            Gr.Properties("PenWidth") = 0.03
            Gr.Properties("PenColor") = RGB(0, 255, 0)
            Set Gr = Grs.AddCircleCenterAndPoint(X0 - a / 2 + R, y0 + b / 2 - R, 0, X0 - a / 2 + R, y0 + b / 2 - R + r1, 0)
            Gr.Properties("PenWidth") = 0.03
            Gr.Properties("PenColor") = RGB(0, 255, 0)
        End If
    End If
End Sub

Public Sub RRectWithThick()
' Create 3D-RoundRectangle with holes as surface
    Dim App As Application
    Dim ActDr As Drawing
    Set App = IMSIGX.Application
    Set ActDr = App.ActiveDrawing
Dim Space%
    Space = ActDr.Properties("TileMode")
    If Space <> 1 Then
        MsgBox ("This macros works only in Model Space")
        Exit Sub
    End If
    Dim Grs As Graphics
    Dim Gr As Graphic
    Dim GrChild As Graphic
    Dim a#, b#, R#, r1#, Thick#
    Dim X0#, y0#
    Dim Pi#
    Pi = 3.14159
    X0 = 5
    y0 = 5
    frmRRect.Show
    a = CDbl(frmRRect.TextBox1.Text)
    b = CDbl(frmRRect.TextBox2.Text)
    R = CDbl(frmRRect.TextBox3.Text)
    r1 = CDbl(frmRRect.TextBox4.Text) / 2
    Thick = CDbl(frmRRect.TextBox5.Text)
    If R <= 0 Then R = 0
    If r1 > R Then r1 = 0
    Set Grs = ActDr.Graphics
    Set Gr = Grs.Add(7) ' graphic of Group type
    If R = 0 Then
        Set Gr = Grs.AddLineRectangle(X0 - a / 2, y0 - b / 2, 0, X0 + a / 2, y0 + b / 2, 0)
    Else
        ' Add Line segments
        Set GrChild = Gr.Graphics.AddLineSingle(X0 - a / 2 + R, y0 - b / 2, 0, X0 + a / 2 - R, y0 - b / 2, 0)
        Set GrChild = Gr.Graphics.AddLineSingle(X0 + a / 2, y0 - b / 2 + R, 0, X0 + a / 2, y0 + b / 2 - R, 0)
        Set GrChild = Gr.Graphics.AddLineSingle(X0 - a / 2 + R, y0 + b / 2, 0, X0 + a / 2 - R, y0 + b / 2, 0)
        Set GrChild = Gr.Graphics.AddLineSingle(X0 - a / 2, y0 - b / 2 + R, 0, X0 - a / 2, y0 + b / 2 - R, 0)
        ' Add Arcs
        Set GrChild = Gr.Graphics.AddArcCenterAndPoint(X0 - a / 2 + R, y0 - b / 2 + R, 0, X0 - a / 2 + R, y0 - b / 2, 0, Pi, 3 * Pi / 2)
        Set GrChild = Gr.Graphics.AddArcCenterAndPoint(X0 + a / 2 - R, y0 - b / 2 + R, 0, X0 + a / 2 - R, y0 - b / 2, 0, 3 * Pi / 2, 2 * Pi)
        Set GrChild = Gr.Graphics.AddArcCenterAndPoint(X0 + a / 2 - R, y0 + b / 2 - R, 0, X0 + a / 2 - R, y0 + b / 2, 0, 0, Pi / 2)
        Set GrChild = Gr.Graphics.AddArcCenterAndPoint(X0 - a / 2 + R, y0 + b / 2 - R, 0, X0 - a / 2 + R, y0 + b / 2, 0, Pi / 2, Pi)
        ' Add Circles
        If r1 > 0 Then
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X0 - a / 2 + R, y0 - b / 2 + R, 0, X0 - a / 2 + R, y0 - b / 2 + R + r1, 0)
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X0 + a / 2 - R, y0 - b / 2 + R, 0, X0 + a / 2 - R, y0 - b / 2 + R + r1, 0)
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X0 + a / 2 - R, y0 + b / 2 - R, 0, X0 + a / 2 - R, y0 + b / 2 - R + r1, 0)
            Set GrChild = Gr.Graphics.AddCircleCenterAndPoint(X0 - a / 2 + R, y0 + b / 2 - R, 0, X0 - a / 2 + R, y0 + b / 2 - R + r1, 0)
        End If
    End If
Dim GrHatch As Graphic
        Gr.Closed = True
        Set GrHatch = Gr.Graphics.AddHatch 'Adds a hatch pattern to the collection from the Graphic objects in the collection.
        GrHatch.Properties("PenColor") = RGB(255, 0, 0) 'Changes color of the hatch-object
        If Thick > 0 Then
            GrHatch.Properties("Thickness") = Thick 'Changes the property - "Thickness"
            GrHatch.Properties("Solid") = 0 ' Resulting object is Surface
        End If
End Sub


Examples - LineStyles and BrushStyles Macro - modStyles.bas

modStyles.bas

LineStyles and BrushStyles Macro Example

Attribute VB_Name = "modStyles"
Option Explicit

Sub ShowLineStyles()
    On Error Resume Next
    Dim st As IMSIGX.LineStyle
    Debug.Print "LineStyles"
    For Each st In ActiveDrawing.LineStyles
        ShowLineStyle st
    Next
End Sub

Sub ShowProperties(ByVal props As IMSIGX.Properties)
    On Error Resume Next
    Dim prop As IMSIGX.Property
    Debug.Print "Properties"
    For Each prop In props
        ShowProperty prop
    Next
End Sub

Sub ShowProperty(ByVal prop As IMSIGX.Property)
    On Error Resume Next
    Debug.Print "Property"
    Debug.Print " Name: " & prop.Name
    Debug.Print " Type: " & prop.Type
    Debug.Print " Value: " & prop.Value
End Sub

Function FindNamedColor(ByVal clr As Long, maxDist As Long) As IMSIGX.NamedColor
    On Error Resume Next
    Dim nclr, best As IMSIGX.NamedColor
    Dim tr, tg, tb As Long
    Dim dr, dg, db, i As Long
    Set best = Nothing
    tr = clr Mod 256&
    tg = (clr \ 256&) Mod 256&
    tb = (clr \ (256& * 256&)) Mod 256&
    Debug.Print Application.NamedColors.Count; " named colors"
    i = 0
    For Each nclr In Application.NamedColors
        clr = nclr.Color
        If clr >= 0 Then
            dr = clr Mod 256&
            dg = (clr \ 256&) Mod 256&
            db = (clr \ (256& * 256&)) Mod 256&
            dr = tr - dr
            If dr < 0 Then dr = -dr
            dg = tg - dg
            If dg < 0 Then dg = -dg
            db = tb - db
            If db < 0 Then db = -db
            Debug.Print "(" & i & ") " & nclr.Name & " " & dr & " " & dg & " " & db
            If dr < maxDist And dg < maxDist And db < maxDist Then
                If dr < dg Then
                    maxDist = dr
                Else
                    maxDist = dg
                End If
                If db < maxDist Then
                    maxDist = db
                End If
                Set best = nclr
                If maxDist = 0 Then Exit For
            End If
        End If
        i = i + 1
    Next
    Set FindNamedColor = best
End Function

Sub ShowColorProperty(ByVal prop As IMSIGX.Property)
    On Error Resume Next
    Dim r, g, b, clr, maxDist As Long
    Dim nclr As IMSIGX.NamedColor
    Debug.Print prop.Name
    clr = prop.Value
    If clr >= 0 Then
        r = clr Mod 256&
        g = (clr \ 256&) Mod 256&
        b = (clr \ (256& * 256&)) Mod 256&
        Debug.Print clr & " (&H" & Hex$(clr) & ") = RGB(" & r & ", " & g & ", " & b & ")"
        maxDist = 10
        Set nclr = FindNamedColor(clr, maxDist)
        If Not nclr Is Nothing Then
            Debug.Print "->" & nclr.Name
        End If
    Else
        Debug.Print clr
    End If
End Sub

Sub ShowBrushStyles()
    On Error Resume Next
    Dim st As IMSIGX.BrushStyle
    Debug.Print "BrushStyles"
    For Each st In ActiveDrawing.BrushStyles
        ShowBrushStyle st
    Next
End Sub

Sub ShowLineStyle(ByVal st As IMSIGX.LineStyle)
    On Error Resume Next
    Dim j As Long
    Dim dashes As Variant
    Debug.Print "LineStyle"
    Debug.Print " Name: " & st.Name
    Debug.Print " Description: " & st.Description
    Debug.Print " PatternLength: " & st.PatternLength
    Debug.Print " Dashes"
    st.GetDashes dashes
    For j = LBound(dashes) To UBound(dashes)
        Debug.Print "  (" & j & ") " & dashes(j)
    Next j
End Sub

Sub ShowBrushStyle(ByVal st As IMSIGX.BrushStyle)
    On Error Resume Next
    Debug.Print "BrushStyle"
    Debug.Print " Name: " & st.Name
    Debug.Print " Description: " & st.Description
    Debug.Print " Type: " & st.Type
    Debug.Print " Color: " & st.Color
    Debug.Print " Bitmap: " & st.Bitmap
    Debug.Print " HatchStyle: " & st.HatchStyle
    ShowBrushPatterns st.Patterns
End Sub

Sub ShowBrushPatterns(ByVal pats As IMSIGX.BrushPatterns)
    On Error Resume Next
    Debug.Print "BrushPatterns"
    Dim pat As IMSIGX.BrushPattern
    For Each pat In pats
        ShowBrushPattern pat
    Next pat
End Sub

Sub ShowBrushPattern(ByVal pat As IMSIGX.BrushPattern)
    On Error Resume Next
    Dim dashes As Variant
    Dim i, j As Long
    Dim x, y, w, h, a As Double
    Debug.Print "BrushPattern"
    pat.GetItem i, dashes, x, y, w, h, a
    Debug.Print " Item: " & i
    Debug.Print " Dashes: "
    For j = LBound(dashes) To UBound(dashes)
        Debug.Print "  (" & j & ") " & dashes(j)
    Next j
    Debug.Print " X: " & x
    Debug.Print " Y: " & y
    Debug.Print " Width: " & w
    Debug.Print " Height: " & h
    Debug.Print " Angle: " & a
End Sub

Sub ShowSelStyles()
    On Error Resume Next
    Dim gr As Graphic
    For Each gr In ActiveDrawing.Selection
        DebugPrint "Graphic -- " & gr.Type
        ShowLineStyle gr.LineStyle
        ShowBrushStyle gr.BrushStyle
        ShowColorProperty gr.Properties("PenColor")
        ShowColorProperty gr.Properties("BrushColor")
    Next
End Sub


Examples - Text Macro - modText.bas

modText.bas

Text Macro Example

Attribute VB_Name = "modText"
' This sample draws texts

Public Sub TextJustification()
'Sample draws texts with different Justification

Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim GrText As Graphic
Dim Pi#
    Pi = 3.14159
Dim Justification%
Dim ThisText$
    Set App = IMSIGX.Application
    Set ActDr = App.ActiveDrawing
    Set Grs = ActDr.Graphics
   ' .AddText(Text, X0, Y0, Z0, Height, Angle, Width, Offset,Justification)
    For Justification = 1 To 5
        ThisText = "Justification = " & CStr(Justification)
        Set GrText = Grs.AddText(ThisText, 2, CDbl(Justification), 0, 0.5, 0, , , Justification)
    Next Justification
End Sub
Public Sub TextFont()
'Sample draw texts with different TextFont
Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim GrText As Graphic
Dim Pi#
    Pi = 3.14159
Dim TextFont%
Dim ThisText(8) As String
    ThisText(0) = "TimesNewRoman"
    ThisText(1) = "Italic"
    ThisText(2) = "GothicE"
    ThisText(3) = "CityBlueprint"
    ThisText(4) = "GreekS"
    ThisText(5) = "Impact"
    ThisText(6) = "Monotxt"
    Set App = IMSIGX.Application
    Set ActDr = App.ActiveDrawing
    Set Grs = ActDr.Graphics
Dim x0#, y0#, angle#
   ' .AddText(Text, X0, Y0, Z0, Height, Angle, Width, Offset,Justification)
    For TextFont = 0 To 6
        angle = 2 * Pi / 7 * TextFont
        x0 = 5 + 0.5 * Cos(angle)
        y0 = 5 + 0.5 * Sin(angle)
        Set GrText = Grs.AddText(ThisText(TextFont), x0, y0, 0, 0.5, angle)
        GrText.Properties("TextFont") = ThisText(TextFont)
        GrText.Properties("PenColor") = QBColor(2 * TextFont)
    Next TextFont
End Sub

Public Sub TextMode()
'Sample draw texts with different textMode

Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim GrText As Graphic
Dim Pi#
    Pi = 3.14159
Dim txtMode(3) As String
    txtMode(1) = "Standard"
    txtMode(2) = "Scalable"
    txtMode(3) = "Flexible"
Dim Mode%
Dim ThisText$
    Set App = IMSIGX.Application
    Set ActDr = App.ActiveDrawing
    Set Grs = ActDr.Graphics
   ' .AddText(Text, X0, Y0, Z0, Height, Angle, Width, Offset,Justification)
    For Mode = 1 To 3
        Set GrText = Grs.AddText(txtMode(Mode), 2, CDbl(Mode), 0, 0.5)
        GrText.Properties("TextMode") = Mode
   Next Mode
End Sub

Public Sub TextAlongCircle()
Dim App As Application
Dim ActDr As Drawing
Dim Grs As Graphics
Dim GrText As Graphic
Dim GrCircle As Graphic
Dim Pi#
    Pi = 3.14159
    Set App = IMSIGX.Application
    Set ActDr = App.ActiveDrawing
    Set Grs = ActDr.Graphics

    Set GrCircle = Grs.AddCircleCenterAndPoint(5, 5, 0, 5, 8, 0)
Dim xc#, yc#, R#, xr#, yr#
Dim ArcData(10) As Double
    GrCircle.GetArcData ArcData
    xc = ArcData(0)
    yc = ArcData(1)
    xr = ArcData(3)
    yr = ArcData(4)
    R = Sqr((xr - xc) * (xr - xc) + (yr - yc) * (yr - yc))
Dim ThisText$
    ThisText = "QRwetweteteghghlkdfjhjdj"
Dim txtLen As Long, i As Long
Dim Symb$
Dim dfi#, fi#, x#, y#
Dim fiBeg#, fiEnd#
    fiBeg = 7 / 8 * Pi
    fiEnd = 1 / 4 * Pi
Dim Htext#
    Htext = 0.25
    txtLen = Len(ThisText)
    dfi = (fiBeg - fiEnd) / (txtLen - 1)
    For i = 1 To txtLen
        Symb = Mid(ThisText, i, 1)
        fi = Pi - dfi * (i - 1)
        x = xc + R * Cos(fi)
        y = yc + R * Sin(fi)
        Set GrText = Grs.AddText(Symb, x, y, 0, Htext, fi - Pi / 2, , , 3)
        x = xc + (R + 1.1 * Htext) * Cos(fi)
        y = yc + (R + 1.1 * Htext) * Sin(fi)
        Set GrText = Grs.AddText(Symb, x, y, 0, Htext, fi - Pi / 2, , , 3)
        GrText.Properties("PenColor") = QBColor(13)

    Next i

End Sub


Examples - Title Block - modTitleBlock.bas

modTitleBlock.bas

Title Block Example

Attribute VB_Name = "modTitleBlock"
Option Explicit

Sub SetTitleBlock()

'Code in this listing does several things:
'First, we get a reference to the active drawing object, then we set its
'drawing mode to Paper Space (Paper Space and Model Space will be discussed
'in Chapter 5), then we define paper size, calculate and draw border
'rectangle within defined paper space and margins, then draw the title box
'within the border rectangle (as a table), and then fill two cells of the
'title box table with simple text: "Design By" and "Project".

'Set up error handler
  On Error GoTo SetTitleBlock_Err

'Declare and set major TurboCAD objects
  Dim ActDr As Drawing
  Dim Grs As Graphics
  Dim Gr As Graphic
  Dim Vi As View

'Get active drawing object
  Set ActDr = ActiveDrawing

'Set active drawing space: Paper Space = 0, Model Space = 1
  ActDr.Properties("TileMode") = 0

'Get graphics collection of the active drawing
  Set Grs = ActDr.Graphics

'Set measurement units for the current drawing space to inches
  ActDr.Properties("PaperLinearUnitName") = "in"

'Declare variables to hold paper size data
  Dim PSetUp As PageSetup
  Dim SpaceUnits$, UnitScale#
  Dim PaperWidth#, PaperHeight#

'Read property (we set it to inches ealier in the code)
    SpaceUnits = ActDr.Properties("PaperLinearUnitName")

'Read paper size properties (we don't need to do that, it's just an illustration)
    Set PSetUp = ActDr.PageSetup
    PaperWidth = PSetUp.SheetWidth
    PaperHeight = PSetUp.SheetHeight

'Set paper size
    PaperWidth = 12#
    PaperHeight = 10#

'Define scaling rate depending on measurement units specified by user
'(in our case we programmtically set 'PaperLinearUnitName' to inches –
'see code above).We need to convert user measurement units to millimiters
'(TurboCAD's internal measurement units)
    If SpaceUnits = "mm" Then UnitScale = 1
    If SpaceUnits = "cm" Then UnitScale = 10
    If SpaceUnits = "m" Then UnitScale = 100
    If SpaceUnits = "in" Or SpaceUnits = """" Then UnitScale = 25.4
    If SpaceUnits = "ft" Or SpaceUnits = "'" Then UnitScale = 25.4 * 12

    PSetUp.SheetWidth = PaperWidth * UnitScale
    PSetUp.SheetHeight = PaperHeight * UnitScale

'Calculate rectangle for the frame based on defined paper size including margins
  Dim LeftMargin#, RightMargin#, TopMargin#, BottomMargin#
  Dim xLeft#, xRight#, yBottom#, yTop#
    LeftMargin = 1
    RightMargin = 0.5
    TopMargin = 0.5
    BottomMargin = 0.5

    xLeft = LeftMargin
    xRight = PaperWidth - RightMargin
    yBottom = BottomMargin
    yTop = PaperHeight - TopMargin

'Draw frame
    Set Gr = Grs.Add(imsiPolyline)
    With Gr.Vertices
        .Add xLeft, yBottom, 0
        .Add xRight, yBottom, 0
        .Add xRight, yTop, 0
        .Add xLeft, yTop, 0
        .AddClose
    End With
    Gr.Properties("PenWidth") = 0.01
    Gr.Draw

'Draw Title Box (as a table)
  Dim GrTable As Graphic
  Dim hTable#, wTable#
  Dim xL#, xR#, yB#, yT#, xMid#, yMid#

    hTable = 1
    wTable = 6

    xL = xRight - wTable
    xR = xL + wTable
    yB = yBottom
    yT = yB + hTable
    xMid = (xL + xR) / 2
    yMid = (yB + yT) / 2

    Set GrTable = Grs.Add(imsiPolyline)
    With GrTable.Vertices
        .Add xL, yB, 0
        .Add xR, yB, 0
        .Add xR, yT, 0
        .Add xL, yT, 0
        .Add xL, yB, 0
        .Add xL, yMid, 0, False
        .Add xR, yMid, 0
        .Add xMid, yB, 0, False
        .Add xMid, yT, 0
    End With
    GrTable.Properties("PenWidth") = 0.01
    GrTable.Draw

'Add text to table
  Dim GrText As Graphic
  Dim InputString$

    InputString = "Design By"
    Set GrText = Grs.AddText(InputString, (xL + xMid) / 2, yT, 0, hTable / 2, , , , 2)
    InputString = "Project"
    Set GrText = Grs.AddText(InputString, (xMid + xR) / 2, yT, 0, hTable / 2, , , , 2)

'Get actiev view of the active drawing…
  Set Vi = ActDr.Views(0)
'… and fit drawing to screen
  Vi.ZoomToExtents

SetTitleBlock_Exit:

'Destroy TurboCAD objects
    Set ActDr = Nothing
    Set Grs = Nothing
    Set PSetUp = Nothing
    Set Gr = Nothing
    Set GrTable = Nothing
    Set GrText = Nothing
    Set Vi = Nothing

    Exit Sub

SetTitleBlock_Err:
    If Err.Number <> 0 Then
       MsgBox "Error " & Err.Number & " in Sub 'SetTitleBlock'" & _
       vbLf & vbLf & Err.Description
       Resume SetTitleBlock_Exit
    End If
End Sub


Examples - Vertex Methods Macro - DialogBox.frm

DialogBox.frm

Vertex Methods Macro Example

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} DialogBox
   Caption         =   "UserForm1"
   ClientHeight    =   6990
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6825
   OleObjectBlob   =   "DialogBox.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "DialogBox"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub CommandButton1_Click()

End Sub


Examples - Vertex Methods Macro - IVertex.bas

IVertex.bas

Vertex Methods Macro Example

Attribute VB_Name = "IVertex"
Public Sub Enumer()
    Dim g As Graphic, gg As Graphic
    Dim v As Vertex

    Set g = IMSIGX.ActiveDrawing.Selection(0) ' the very first one

    Dim s$()

    ReDim s$(g.Vertices.Count)

    For i = 0 To g.Vertices.Count - 1
        Set v = g.Vertices(i)
        s$(i) = Str(i) + Chr(9) + ": "
        s$(i) = s$(i) + Str(v.X) + "," + Str(v.Y) + "," + Str(v.Z)
        If v.Bulge Then s$(i) = s$(i) + ",Bulge:" + Str(v.Bulge)
        If v.Calculated Then s$(i) = s$(i) + ",Clcd"
        If v.Editable Then s$(i) = s$(i) + ",Edbl"
        If v.Linkable Then s$(i) = s$(i) + ",Lnkbl"
        If v.PenDown Then
            s$(i) = s$(i) + ",PenDn"
        Else
            s$(i) = s$(i) + ",PenUp"
        End If
        If v.Selectable Then s$(i) = s$(i) + ",Slctbl"
        If v.Snappable Then s$(i) = s$(i) + ",Snpbl"
        s$(i) = s$(i) + Chr(10)
        Set gg = IMSIGX.ActiveDrawing.Graphics.AddCircle(v.X, v.Y, v.Z)
    Next i
'    MsgBox s$
    Dim box As DialogBox
    Set box = New DialogBox
    box.Text.Caption = "Vertices:" + Chr(10)
    For i = 0 To g.Vertices.Count - 1
        box.Text.Caption = box.Text.Caption + s$(i)
    Next i
    box.Show
End Sub


Examples - Viewport Macro - modViewport.bas

modViewport.bas

Viewport Macro Example

Attribute VB_Name = "modViewport"
Option Explicit

Const strNamedView = "FloorPlan"

Public Sub SetModelSpace()
    On Error Resume Next
    With ActiveDrawing
        Dim Space%
        Space = .Properties("TileMode")
        If Space <> 1 Then
            .Properties("TileMode") = 1
        End If
    End With
End Sub

Public Sub SetPaperSpace()
    On Error Resume Next
    With ActiveDrawing
        Dim Space%
        Space = .Properties("TileMode")
        If Space <> 0 Then
            .Properties("TileMode") = 0
        End If
    End With
End Sub

Public Function FindNamedView(ByVal viewName As String) As NamedView
    On Error GoTo FindError
    Dim count As Long, i As Long
    Dim nvws As NamedViews
    Dim nvw As NamedView

    Set nvws = ActiveDrawing.NamedViews
    count = nvws.count
    For i = 0 To count - 1
        Set nvw = nvws(i)
        If nvw.name = viewName Then
            Set FindNamedView = nvw
            Exit Function
        End If
    Next
FindError:
    Set FindNamedView = Nothing
End Function

Public Sub CreateVpNamedView()
    On Error Resume Next
    Dim nvw As NamedView
    Set nvw = FindNamedView(strNamedView)

    'Only create if it doesn't exist
    If nvw Is Nothing Then
        With ActiveDrawing
            'Set to model space to set up named view
            SetModelSpace

            'Add the named view
            Set nvw = .NamedViews.Add(strNamedView, 0, 0, 100, 100)
        End With
    End If
End Sub

Public Sub DeleteVpNamedView()
    On Error Resume Next
    Dim nvw As NamedView
    Set nvw = FindNamedView(strNamedView)
    If Not nvw Is Nothing Then
        nvw.Delete
    End If
End Sub

Sub AddViewport()
    On Error Resume Next

    'Create named view if it doesn't exist already
    CreateVpNamedView

    'Obtain world coordinates of viewport center and size
    'Drawing must be in paper space mode
    SetPaperSpace
    Dim vx#, vy#, vz#
    Dim wx1#, wy1#, wx2#, wy2#, wz#
    Dim gr1 As Graphic, gr2 As Graphic
    With ActiveDrawing.ActiveView
        MsgBox "Click to define the first corner of the viewport"
        .GetMouseClick vx, vy
        .ViewToWorld vx, vy, vz, wx1, wy1, wz

        'Place corner marker as a helper
        Set gr1 = ActiveDrawing.Graphics.AddCross(wx1, wy1, 0)
        .Refresh

        MsgBox "Click to define the second corner of the viewport"
        .GetMouseClick vx, vy
        .ViewToWorld vx, vy, vz, wx2, wy2, wz

        'Place corner marker as a helper
        Set gr2 = ActiveDrawing.Graphics.AddCross(wx2, wy2, 0)

        'Add the viewport graphic with correct scaling
        AddViewportByName strNamedView, wx1, wy1, wx2, wy2

        'Remove temporary corner markers and show the results
        gr1.Delete
        Set gr1 = Nothing
        gr2.Delete
        Set gr2 = Nothing
        .Refresh
    End With
End Sub

Sub AddViewportByName(ByVal viewName As String, _
    ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double)
    On Error Resume Next
    Dim BBox As BoundingBox

    'Get the named view that we're going to use
    Dim nvw As NamedView
    Set nvw = FindNamedView(viewName)
    If nvw Is Nothing Then
        MsgBox "Named view " & viewName & " not found--can't create viewport"
        Exit Sub
    End If

    'Get bounding box size info from named view
    Set BBox = nvw.BoundingBox
    Dim nvwWidth#, nvwHeight#
    nvwWidth = BBox.Max.X - BBox.Min.X
    nvwHeight = BBox.Max.Y - BBox.Min.Y
    Set BBox = Nothing

    'Drawing must be in paper space mode
    'Viewport graphic goes on paper sapce
    SetPaperSpace

    'Add viewport graphic and set it up
    Dim vpg As Graphic
    Set vpg = ActiveDrawing.Graphics.Add(imsiViewport)
    With vpg

        'Set the NamedView property
        .Properties("NamedView") = viewName

        'Get bounding box size and location info from viewport graphic
        Set BBox = .CalcBoundingBox
        Dim vpgWidth#, vpgHeight#, vpgCenterX#, vpgCenterY#
        vpgWidth = BBox.Max.X - BBox.Min.X
        vpgHeight = BBox.Max.Y - BBox.Min.Y
        vpgCenterX = (BBox.Max.X + BBox.Min.X) / 2
        vpgCenterY = (BBox.Max.Y + BBox.Min.Y) / 2
        Set BBox = Nothing

        'Calculate desired center point
        Dim centerX#, centerY#
        centerX = (x1 + x2) / 2
        centerY = (y1 + y2) / 2

        'Calculate scale factors
        'Choose smallest size for scale
        Dim sizeX#, sizeY#, sc#, scX#, scY#
        If x1 = x2 Then
            sizeX = 1
        Else
            sizeX = Abs(x2 - x1)
        End If
        If y1 = y2 Then
            sizeY = 1
        Else
            sizeY = Abs(y2 - y1)
        End If

        If sizeX < sizeY Then
            scY = sizeX / vpgHeight
            scX = sizeX / vpgWidth
        Else
            scX = sizeY / vpgWidth
            scY = sizeY / vpgHeight
        End If

        'Move viewport graphic to specified location
        .MoveRelative centerX - vpgCenterX, centerY - vpgCenterY, 0

        'Now centered at centerX, centerY
        'Scale (resize) viewport graphic around center
        Dim mtx As Matrix
        Set mtx = .Scale(scX, scY, 1, centerX, centerY, 0)
    End With
    Exit Sub
End Sub


Examples - XRef Macro - mAddViewportTst.bas

mAddViewportTst.bas

XRef Macro Example

Attribute VB_Name = "mAddViewportTst"

Const vpW = 3
Const vpH = 3

Const strXRef1 = "d:\tc80\bin\usa\drawings\drawing1.tcw"
Const strXRef2 = "d:\tc80\bin\usa\drawings\drawing2.tcw"
Const strXRef3 = "d:\tc80\bin\usa\drawings\drawing3.tcw"
Const strXRef4 = "d:\tc80\bin\usa\drawings\drawing4.tcw"

Private Sub AddXRefs()
    Dim gxBlks As Blocks
    Dim gxGrs As Graphics
    Dim gxVrt As Vertex

    Dim x As Double
    Dim y As Double
    Dim z As Double

    Dim dx As Double
    Dim dy As Double
    Dim dz As Double

    Dim gxGrXRef1 As Graphic
    Dim gxGrXRef2 As Graphic
    Dim gxGrXRef3 As Graphic
    Dim gxGrXRef4 As Graphic

    Dim gxBBox1 As BoundingBox
    Dim gxBBox2 As BoundingBox
    Dim gxBBox3 As BoundingBox
    Dim gxBBox4 As BoundingBox

    Set gxBlks = ActiveDrawing.Blocks

    gxBlks.AddXref "XRef1", strXRef1, 0, 0, 0
    gxBlks.AddXref "XRef2", strXRef2, 0, 0, 0
    gxBlks.AddXref "XRef3", strXRef3, 0, 0, 0
    gxBlks.AddXref "XRef4", strXRef4, 0, 0, 0

    Set gxGrs = ActiveDrawing
    Set gxGrXRef1 = gxGrs.AddBlockInsertion("XRef1", 0, 0, 0, 1, 1, 1)
    Set gxGrXRef2 = gxGrs.AddBlockInsertion("XRef2", 0, 0, 0, 1, 1, 1)
    Set gxGrXRef3 = gxGrs.AddBlockInsertion("XRef3", 0, 0, 0, 1, 1, 1)
    Set gxGrXRef4 = gxGrs.AddBlockInsertion("XRef4", 0, 0, 0, 1, 1, 1)

    Set gxBBox1 = gxGrXRef1.CalcBoundingBox
    Set gxBBox2 = gxGrXRef2.CalcBoundingBox
    Set gxBBox3 = gxGrXRef3.CalcBoundingBox
    Set gxBBox4 = gxGrXRef4.CalcBoundingBox

    y = (gxBBox1.Max.y + gxBBox1.Min.y) / 2
    dy = y - ((gxBBox2.Max.y + gxBBox2.Min.y) / 2)

    x = gxBBox1.Max.x + (gxBBox2.Max.x - gxBBox2.Min.x) / 2
    dx = x - (gxBBox2.Max.x + gxBBox2.Min.x) / 2 + 2

    z = (gxBBox1.Max.z + gxBBox1.Min.z) / 2
    dz = z - (gxBBox2.Max.z + gxBBox2.Min.z) / 2

    gxGrXRef2.MoveRelative dx, dy, dz

    x = (gxBBox1.Max.x + gxBBox1.Min.x) / 2
    dx = x - ((gxBBox3.Max.x + gxBBox3.Min.x) / 2)

    y = gxBBox1.Max.y + (gxBBox3.Max.y - gxBBox3.Min.y) / 2
    dy = y - (gxBBox3.Max.y + gxBBox3.Min.y) / 2 + 2

    z = (gxBBox1.Max.z + gxBBox1.Min.z) / 2
    dz = z - (gxBBox3.Max.z + gxBBox3.Min.z) / 2

    gxGrXRef3.MoveRelative dx, dy, dz

    Set gxBBox3 = gxGrXRef3.CalcBoundingBox

    y = (gxBBox3.Max.y + gxBBox3.Min.y) / 2
    dy = y - ((gxBBox4.Max.y + gxBBox4.Min.y) / 2)

    x = gxBBox3.Max.x + (gxBBox4.Max.x - gxBBox4.Min.x) / 2
    dx = x - (gxBBox4.Max.x + gxBBox4.Min.x) / 2 + 2

    z = (gxBBox3.Max.z + gxBBox3.Min.z) / 2
    dz = z - (gxBBox4.Max.z + gxBBox4.Min.z) / 2

    gxGrXRef4.MoveRelative dx, dy, dz

    ActiveDrawing.ActiveView.ZoomToExtents

End Sub

Private Function AddXRefNamedView(gxNVws As NamedViews, gxGr As Graphic) As Long

    Dim gxBBox As BoundingBox
    Dim cnt As Long

    cnt = 0
    If (gxGr.TypeByValue <> imsiInsert) Then
        GoTo LExit
    End If

    Set gxBBox = gxGr.CalcBoundingBox

    On Error GoTo LExit
    gxNVws.Add "View to " & gxGr.Block.Name, gxBBox.Min.x - 1, gxBBox.Min.y - 1, gxBBox.Max.x + 1, gxBBox.Max.y + 1

    cnt = 1

LExit:
    AddXRefNamedView = cnt

End Function

Private Function AddXRefNamedViews(gxNVws As NamedViews) As Long

    Dim cnt As Long

    Dim gxGrs As Graphics
    Dim gxGr As Graphic

    Dim gxCam As Camera

    Dim gxVPos As Vertex
    Dim gxVLook As Vertex
    Dim gxVDir As Vertex

    cnt = 0

    AddXRefs

    Set gxCam = ActiveDrawing.ActiveView.Camera

    Set gxVPos = gxCam.Location
    Set gxVLook = gxCam.LookAt
    Set gxVDir = gxCam.Direction

    gxVPos.x = 0
    gxVPos.y = 0
    gxVPos.z = 1

    gxVLook.x = 0
    gxVLook.y = 0
    gxVLook.z = 0

    gxVDir.x = 0
    gxVDir.y = 1
    gxVDir.z = 0

    gxCam.CameraSetSpaceParameters gxVPos, gxVLook, gxVDir

    ActiveDrawing.ActiveView.ZoomToExtents

    Set gxGrs = ActiveDrawing.Graphics

    For Each gxGr In gxGrs

        cnt = cnt + AddXRefNamedView(gxNVws, gxGr)

    Next

    AddXRefNamedViews = cnt

End Function

Private Function AddXRefViewport(gxGrs As Graphics, gxNVw As NamedView) As Graphic

    Dim gxGr As Graphic
    Dim gxVrts As Vertices
    Dim gxVrt As Vertex
    Dim right As Double
    Dim bottom As Double
    Dim left As Double
    Dim top As Double

    Set gxGr = gxGrs.Add(imsiViewport)
    gxGr.Properties("NamedView") = gxNVw.Name

    Set gxVrts = gxGr.Vertices
    Set gxVrt = gxVrts(0)
    left = gxVrt.x
    top = gxVrt.y

    right = left + vpW
    bottom = top - vpH

    Set gxVrt = gxVrts(1)
    gxVrt.y = bottom

    Set gxVrt = gxVrts(2)
    gxVrt.y = bottom
    gxVrt.x = right

    Set gxVrt = gxVrts(3)
    gxVrt.x = right

    Set AddXRefViewport = gxGr

End Function

Public Sub AddXRefViewports()

    Dim gxNVws As NamedViews

    Dim gxProps As Properties
    Dim gxProp As Property
    Dim OldSpace As Long

    Dim gxGrs As Graphics
    Dim gxGr As Graphic

    Dim cnt As Long
    Dim cntCur As Long
    Dim cntOld As Long
    Dim ind As Long

    Dim dXY As Integer
    Dim vpX As Double
    Dim vpY As Double

    Set gxProps = ActiveDrawing.Properties
    Set gxProp = gxProps("TileMode")

    OldSpace = gxProp

    If (OldSpace <> 1) Then
        gxProp = 1 ' set model space
    End If

    Set gxProps = ActiveDrawing.Properties
    Set gxProp = gxProps("TileMode")

    OldSpace = gxProp

    If (OldSpace <> 1) Then
        gxProp = 1 ' set model space
    End If

    Set gxNVws = ActiveDrawing.NamedViews
    cntOld = gxNVws.Count
    cnt = AddXRefNamedViews(gxNVws)

    If (cnt > 0) Then
        gxProp = 0 ' set paper space

        Set gxGrs = ActiveDrawing.Graphics
        cntCur = gxNVws.Count

        vpX = vpW / 2 + 0.5
        vpY = vpH / 2 + 1
        dXY = 0

        For ind = cntOld To cntCur - 1

            Set gxGr = AddXRefViewport(gxGrs, gxNVws(ind))

            gxGr.MoveAbsolute vpX, vpY, 0

            Select Case dXY
            Case 1
                vpX = vpX + vpW + 1
                dXY = dXY + 1
            Case 0
                vpY = vpY + vpH + 1
                dXY = dXY + 1
            Case 3
                vpX = vpX - vpW - 1
                dXY = dXY + 1
            Case 2
                vpY = vpY - vpH - 1
                dXY = 0
            End Select

            gxGr.Draw

        Next ind

    Else
        gxProp = OldSpace
    End If

End Sub


Examples - Internet Palette Scripts - &&

&&

Internet Palette Scripts Example

<HTML>
<HEAD><TITLE></TITLE>
<META content="text/html; charset=unicode" http-equiv=Content-Type>

<SCRIPT ID=Main Name="Main" LANGUAGE=vbscript>
<!--
option Explicit

'////////// Plugin Common Part /////////////////////
Sub window_onload
    StBase.ToolName = "Calculator"
    StBase.ToolVer = "1.01"

    StCalculator.IsShowable = true

    '// Set Initial size
    StBase.ResizeAllScriplets

    '// Init history control
    InitHistory

    '// TODO your code
    InitToolBar

    UpdateUI
End Sub

Sub window_onresize
    StBase.ResizeAllScriplets' // Resize all Scriptlets Controls
End Sub

Sub window_onhelp
'	StBase.Help
End Sub

'// InitHistory
'//
Sub InitHistory
    with StHistory.ListView
    .Font = "Verdana, Arial, Helvetica"
    .Font.Size = 8

    .ColumnHeaders.Clear
    .ColumnHeaders.Add  1,,"Operation", StHistory.Width * 0.3 - 1
    .ColumnHeaders.Add 2, ,"Value", StHistory.Width * 0.7 - 1
    .GridLines = true
    End With

    '// Hide History
    StHistory.Hide(StHistory)
    StHistory.IsShowable = false
End Sub '//InitHistory

'// InitToolBar
'//
sub InitToolBar

    '// Add Images
    With StToolBar.ImgList.ListImages
    .Clear
    .Add  ,"History",	LoadPicture(StBase.ImagePath + "TLB_CalcHistory.bmp")
    .Add  ,"Clear History",LoadPicture(StBase.ImagePath + "TLB_Delete.bmp")
    .Add  ,"Help",		LoadPicture(StBase.ImagePath + "TLB_Help.bmp")
    StToolBar.SetImageList
    End With

    '// Add Buttons
    With StToolBar.ToolBar.Buttons
    .Add (, "History",,1,"History").ToolTipText = "History"
    .Add (, "Clear History",,0,"Clear History").ToolTipText = "Clear History"
    .Add  ,	, , StToolBar.tbrSeparator
'//	.Add (, "Help", ,,"Help").ToolTipText = "Help"
'//	.Add  ,	, , StToolBar.tbrSeparator
     End With
end sub '//InitToolBar

sub UpdateUI
    '// Update ToolBar
    with StToolBar.ToolBar
        .Buttons("Clear History").Enabled	= (StHistory.ListView.ListItems.Count <> 0)
     end with
end sub

-->
</SCRIPT>

<!-- event From StCalculator -->
<SCRIPT language="vbscript" for=StCalculator event="onscriptletevent(eventname, eventdata)">
   dim item
    with StHistory.ListView
        set item = .ListItems.Add(1, ,eventname)
        item.SubItems(1) = eventdata
    End With
    UpdateUI
</SCRIPT>

<!-- event From StHistory -->
<SCRIPT language="vbscript" for=StHistory event="onscriptletevent(eventname, eventdata)">
    select case eventname
        '// DblClick
        case "DblClick"
            StCalculator.CalculatorVal = eventdata
    end select
    UpdateUI
</SCRIPT>

<!-- event From StToolBar -->
<SCRIPT language="vbscript" for=StToolBar event="onscriptletevent(eventname, eventdata)">
'// event From StToolBar
    select case eventname
        case "ButtonClick"
            select case eventdata.Key
                case "History"
                    if StHistory.IsShowable then
                        StHistory.Hide(StHistory)
                    else
                        StHistory.Show(StHistory)
                    end if
                    StHistory.IsShowable = not StHistory.IsShowable
                case "Help"

                    'StBase.Help

                case "Clear History"
                    StHistory.ListView.ListItems.Clear
             end select
    end select
    UpdateUI
</SCRIPT>

</HEAD>
<BODY bgcolor=#e6e6e6 style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small" scroll=no>

<!-- StBase: Plugin base module (Header, Stop, Star, About, resize ...)-->
<OBJECT height=19 id=StBase name=StBase
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 102"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StBase.htm"></OBJECT>

<!-- StToolBar -->
<OBJECT height=24 id=StToolBar name=StToolBar
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 21px; Z-INDEX: 102"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StToolBar.htm"></OBJECT>

<!-- StCalculator -->
<OBJECT height=180 id=StCalculator name=StCalculator
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 19px; Z-INDEX: 104"
type=text/x-scriptlet width=267><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StCalculator.htm"></OBJECT>

<!-- StHistory -->
<OBJECT height=180 id=StHistory name=StHistory
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 195px; Z-INDEX: 104"
type=text/x-scriptlet width=267><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StListView.htm"></OBJECT>

</BODY>
</HTML>


Examples - Internet Palette Scripts - C&&

C&&

Internet Palette Scripts Example

<HTML>
<HEAD>
<META name=VI60_defaultClientScript content=VBScript><TITLE></TITLE>
<META content="text/html; charset=unicode" http-equiv=Content-Type>

<SCRIPT ID=Main Name="Main" LANGUAGE=vbscript>
<!--
option Explicit

'// Prefix Component as: CURVESCRIPT_3D_PARAM1_Sin
const PREFIX_CURVE = "CURVESCRIPT_"
const PREFIX_3D = "3D_"
const PREFIX_2D = "2D_"
const PREFIX_PARAM = "PARAM1_"
const PREFIX_NOPARAM = "PARAM0_"
const Pi = 3.141592653589793238462643

'////////// Plugin Common Part /////////////////////
Sub window_onload
    StBase.ToolName = "Curve Lab"
    StBase.ToolVer = "1.01"

    '// Set Initial size
    StBase.ResizeAllScriplets

    '// TODO your code
    InitToolBar
    StTC.CreateEvents(StTC.EventBeforeExit + StTC.EventSelectionChange + StTC.EventStartNewTool)

    window.setTimeout "InitCombo", 0
    'window.setTimeout "UpdateUI", 100
End Sub

Sub window_onresize
    StBase.ResizeAllScriplets' // Resize all Scriptlets Controls
End Sub

Sub window_onhelp
    StBase.Help
End Sub

'// InitToolBar
'//
sub InitToolBar

    '// Add Images
    With StToolBar.ImgList.ListImages
    .Clear
    .Add  ,"CurveUpdate",	LoadPicture(StBase.ImagePath + "TLB_CurveUpdate.bmp")
    .Add  ,"3D",			LoadPicture(StBase.ImagePath + "TLB_2D.bmp")
    .Add  ,"Param",			LoadPicture(StBase.ImagePath + "TLB_CurveParam.bmp")
    StToolBar.SetImageList
    End With

    '// Add Buttons
    With StToolBar.ToolBar.Buttons
    .Add (, "CurveUpdate",,,"CurveUpdate").ToolTipText = "Update Curve (F8)"
    .Add  ,	, , StToolBar.tbrSeparator
    .Add (, "3D",,1,"3D").ToolTipText = "2D/3D Curves toggle (Ctrl - D)"
    .Add (, "Param",,1,"Param").ToolTipText = "Curves in Cartesian form (Ctrl - R)"
    .Add  ,	, , StToolBar.tbrSeparator
    .Add  ,  "Combo",,StToolBar.tbrPlaceholder
     End With
    StToolBar.ToolBar.Buttons("Combo").Width = 180
    StToolBar.ToolBar.Buttons("CurveUpdate").Enabled = false
    StToolBar.ToolBar.Buttons("3D").Enabled = false
end sub '//InitToolBar

sub UpdateUI
    dim SelectionCount, TileMode

    if (StTC.objApp.Drawings.count <> 0) then
        SelectionCount = StTC.objApp.Selection.count
        TileMode = StTC.objApp.ActiveDrawing.Properties("TileMode")

        if SelectionCount = 1 then
            if not StTC.GraphicCanDeleteVertices(StTC.objApp.Selection(0)) then
                SelectionCount = 0
            end if
        end if

    else
        SelectionCount = 0
        TileMode = 0
    end if

    '// Update ToolBar
    with StToolBar.ToolBar
        .Buttons("CurveUpdate").Enabled	= (SelectionCount = 1)

        if (TileMode = 0) then '// PAPER_SPACE) then
            if (.Buttons("3D").value = 1) then
                .Buttons("3D").value = 0
                UpdateCombo
            end if
            .Buttons("3D").Enabled = false
        else
            .Buttons("3D").Enabled = true
        end if

     end with
end sub

'// InitCombo
'//
sub InitCombo
    With Combo
      .style.Width = StToolBar.ToolBar.Buttons("Combo").Width
      .style.Top = StToolBar.ToolBar.Buttons("Combo").Top + StBase.PixToI(StToolBar.style.top) + 1
      .style.Left = StToolBar.ToolBar.Buttons("Combo").Left
      .style.fontSize = 12
     End With
    UpdateUI
     UpdateCombo
end sub '//InitCombo

'// UpdateCombo
'//
sub UpdateCombo

    dim i
    for i = 1 to Combo.options.length
        Combo.options.remove(0)
    next

    dim b3D, bParam
    b3D = CBool(StToolBar.ToolBar.Buttons("3D").value)
    bParam = CBool(StToolBar.ToolBar.Buttons("Param").value)

    dim ItemPre ,Item, sPrefix
    for i = 0 to document.all.length - 1
        if (document.all.item(i).tagName = "SCRIPT") then'// Check Tag "SCRIPT"
            sPrefix = document.all.item(i).ID
            if (IsPrefixCurve(sPrefix) and (b3D = IsPrefix3D(sPrefix)) and bParam = IsPrefixParam(sPrefix)) then '// Check Tag ID
                set item = document.createElement("Option")
                item.text = PrefixGetCurveName(sPrefix)
                item.value = item.text
                Combo.add(item)
                set item = nothing
            end if
        end if
    next

    '// Get Script from Combo
    StText.value = document.all(GetCurvePrefix + Combo.value).text
    window.status = Combo.value
end sub '//UpdateCombo

function GetCustomScript
    GetCustomScript = document.scripts("CurveScript").text
end function

sub SetCustomScript(str)
    document.scripts("CurveScript").text = str
end sub

dim b3D, bParam
dim StepsCount, StepNumber, GraphicsCount, GraphicNumber,  StepLen, xMin, xMax, tMin, tMax, PenUp
dim DrawStep, TimeOut

TimeOut = 0
StepLen = 0
'// User vars
StepsCount  = 300
GraphicsCount = 1
StepNumber = 0
GraphicNumber = 0
xMin = 0
xMax = 10
tMin = 0
tMax = 2*Pi
PenUp = false
DrawStep = false

Dim Gr, vs
Sub BuildCurve
    '// Check StepsCount
    if StepsCount < 2 then
        Alert "StepsCount must be greater than 1."
        exit sub
    end if

    dim i
    b3D = CBool(StToolBar.ToolBar.Buttons("3D").value)
    bParam = CBool(StToolBar.ToolBar.Buttons("Param").value)

    '// Calc StepLen
    if bParam then
        StepLen = (tMax - tMin)/(StepsCount - 1)
    else
        StepLen = (xMax - xMin)/(StepsCount - 1)
    end if

    '// Init TCW vars
    set gr=STTC.objApp.Selection.Item(0)

    '// Check Pipe property
    dim PropPipe
    On Error Resume Next
    Err.Clear
    set PropPipe = gr.Properties("$PIPE")
    if Err.Number = 0 then
        if (gr.Properties("$PIPE")) = 1 then
            Alert "Object has propery Normal Mode. Please remove this property and try again."
            Set Gr = Nothing
            exit sub
        end if
    end if
    set PropPipe = nothing

    '// Check Closed
    On Error Resume Next
    Err.Clear
        if gr.Properties("Closed") = 1 then gr.Properties("Closed") = 0
    if Err.Number = 0 then
    end if

    '// Todo restore in 6.3
    '// Add/Remove Vertices
    'dim CountVert
    'CountVert = vs.count
    'if  CountVert <> StepsCount then
    '	if CountVert < StepsCount then
    '		for i = CountVert + 1 to StepsCount
    '			vs.Add 0,0,0
    '		next
    '	else
    '		for i = 1 to CountVert - StepsCount
    '			call vs.Remove(CountVert - i)
    '		next
    '	end if
    'end if

    'dim CountVert
    'CountVert = vs.count
    'if  CountVert <> StepsCount then
     'alert CountVert
    'end if

    gr.Unselect
    gr.Draw
    set vs = Gr.Vertices
    vs.clear
    'gr.Draw

    '// Check sintacsis
    On Error Resume Next
    Err.Clear

    for GraphicNumber = 1 to GraphicsCount

        dim grCopy, grNew
        if GraphicNumber > 1 then
            set vs = nothing
            set grNew = gr.Duplicate
            grNew.UnSelect
            set vs = grNew.Vertices
        end if

        BuildCurvePass

        if not IsEmpty(grNew) then
            grNew.Draw
            set grNew = nothing
        end if
    next

    if Err.Number <> 0 then
         MsgBox"Error # " & CStr(Err.Number) & " " & Err.Description & " " & vbCrLf &_
          "GraphicNumber = " & (GraphicNumber-1) & ", StepNumber = " & StepNumber & " "
    end if

    window.status = ""

    '// Update Drawing
    StTC.objApp.ActiveDrawing.Graphics.Remove(gr.Index)
    StTC.objApp.ActiveDrawing.Graphics.AddGraphic(gr)
    gr.Update
    'gr.UnSelect

    gr.Select
    gr.Draw

    STTC.objApp.ActiveDrawing.RenderScenesGraphicsUpdate Gr, 2
    STTC.objApp.ActiveDrawing.RenderScenesUpdateChanges

    set vs = nothing
    Set Gr = Nothing
End Sub '//BuildCurve

Sub EvalXYZ(vx, vy, vz)
dim t
    if b3D then
        if bParam then
            t = tMin + StepNumber * StepLen
            vx = x(t)
            vy = y(t)
            vz = z(t)
        else
            vx = xMin + StepNumber * StepLen
            vy = y(vx)
            vz = z(vx)
        end if
    else
        if bParam then
            t = tMin + StepNumber * StepLen
            vx = x(t)
            vy = y(t)
            vz = 0
        else
            vx = xMin + StepNumber * StepLen
            vy = y(vx)
            vz = 0
        end if
    end if
End Sub '//EvalXYZ

Sub BuildCurvePass
    dim vx, vy, vz, v
    StepNumber = 0

    if vs.count <> 0 then
        for each v in vs
            if ((StepNumber mod 100) = 0 ) then
                window.status = "Step: " + CStr(StepNumber)
            end if

            PenUp = false
            DrawStep = false
            TimeOut = 0
            call EvalXYZ(vx, vy, vz)

            with v
                .x = vx
                .y = vy
                .z = vz
                if PenUp <> not .PenDown then .PenDown = not PenUp
            end with

            '// Services
            'if DrawStep then Gr.Draw
            StepNumber = StepNumber + 1
        next
    else
        for StepNumber = 0 to StepsCount - 1
            if ((StepNumber mod 100) = 0 ) then
                window.status = "Step: " + CStr(StepNumber)
            end if

            PenUp = false
            call EvalXYZ(vx, vy, vz)

            if PenUp = false then
             vs.Add vx,vy,vz
            else
             set v = vs.Add(vx,vy,vz)
             v.PenDown = false
             set v = nothing
            end if

            '// Services
            'if DrawStep then Gr.Draw

        next
    end if

End Sub '//BuildCurvePass

sub StTCEvent
    UpdateUI
    StTC.ReleaseEvent(StTC.EventsFlag) '// Release All Events
end sub

function GetCurvePrefix
    GetCurvePrefix = PREFIX_CURVE

    if (StToolBar.ToolBar.Buttons("3D").value) then
        GetCurvePrefix = GetCurvePrefix + PREFIX_3D
    else
        GetCurvePrefix = GetCurvePrefix + PREFIX_2D
    end if

    if (StToolBar.ToolBar.Buttons("Param").value) then
        GetCurvePrefix = GetCurvePrefix + PREFIX_PARAM
    else
        GetCurvePrefix = GetCurvePrefix + PREFIX_NOPARAM
    end if

end function

function IsPrefixCurve(sCurveScriptName)
    if InStr(1 ,sCurveScriptName, PREFIX_CURVE, 1) = 1 then
        IsPrefixCurve = TRUE
    else
        IsPrefixCurve = FALSE
    end if
end function

function IsPrefix3D(sCurveScriptName)
    if InStr(1, sCurveScriptName, PREFIX_CURVE + PREFIX_3D, 1) = 1 then
        IsPrefix3D = TRUE
    else
        IsPrefix3D = FALSE
    end if
end function

function IsPrefixParam(sCurveScriptName)
    dim sPrefix3D, sPrefix2D
    sPrefix3D = PREFIX_CURVE + PREFIX_3D + PREFIX_PARAM
    sPrefix2D = PREFIX_CURVE + PREFIX_2D + PREFIX_PARAM

    if (InStr(1, sCurveScriptName, sPrefix3D, 1) = 1) or (InStr(1, sCurveScriptName, sPrefix2D, 1) = 1) then
        IsPrefixParam = TRUE
    else
        IsPrefixParam = FALSE
    end if
end function

function PrefixGetCurveName(sCurveScriptName)
    PrefixGetCurveName = Right(sCurveScriptName, len(sCurveScriptName) - len(PREFIX_CURVE + PREFIX_3D + PREFIX_PARAM))
end function

sub CurveUpdate
    '// Init Vars
    GraphicsCount = 1
    PenUp = false
    DrawStep = false
    TimeOut = 0

    '// Check sintacsis
    On Error Resume Next
    Err.Clear
    execute(StText.value)
    if Err.Number <> 0 then
         MsgBox"Error # " & CStr(Err.Number) & " " & Err.Description
        exit sub
    end if

    call SetCustomScript(StText.value)

    BuildCurve
end sub

Sub Combo_onchange
    dim s
    s = GetCurvePrefix + Combo.value
    StText.value = document.all(s).text
    window.status = Combo.value
End Sub

'// Accelerators routine
'//		F8			CurveUpdate
'//		Ctrl - R	Toggle Cartesian/Normal form of the equalations
'//		Ctrl - D	Toggle 2D/3D form of the equalations
'//		Alt	 - C	Acces Key for ComboBox
Sub StText_onkeydown
    TranslateAccelerators(StText.event)
End Sub

Sub Document_onkeydown
    TranslateAccelerators(window.event)
End Sub

sub TranslateAccelerators(e)
    if e.ctrlKey then
        select case Chr(e.KeyCode)
            case "R"
                if StToolBar.ToolBar.Buttons("Param").Enabled then
                    StToolBar.ToolBar.Buttons("Param").Value = StToolBar.ToolBar.Buttons("Param").Value xor 1
                    UpdateCombo
                end if
            case "D"
                if StToolBar.ToolBar.Buttons("3D").Enabled then
                    StToolBar.ToolBar.Buttons("3D").Value = StToolBar.ToolBar.Buttons("3D").Value xor 1
                    UpdateCombo
                end if
        end select
    else
        select case e.KeyCode
            case 119 '// 119 = F8
                if StToolBar.ToolBar.Buttons("CurveUpdate").Enabled then
                    CurveUpdate
                end if
        end select
    end if

end sub

-->
</SCRIPT>

<!-- event From StBase -->
<SCRIPT language="vbscript" for=StBase event="onscriptletevent(eventname, eventdata)">
    select case eventname

        '// Start
        case "ShowAll"
            Combo.style.display = ""

        '// Stop
        case "HideAll"
            Combo.style.display = "none"
            StTC.DeleteEvents

    end select

</SCRIPT>

<SCRIPT language="vbscript" for=StToolBar event="onscriptletevent(eventname, eventdata)">
'// event From StToolBar
    select case eventname
        case "ButtonClick"
            select case eventdata.Key
                case "CurveUpdate"
                    CurveUpdate

                case "3D", "Param"
                    UpdateCombo
            end select
    end select
</SCRIPT>

<SCRIPT language="vbscript" for=StTC event="onscriptletevent(eventname, eventdata)">
'// event From StTC
    window.setTimeout "StTCEvent", 0
</SCRIPT>

<SCRIPT language="vbscript" for=StText event="onscriptletevent(eventname, eventdata)">
    Alert window.event.ctrlKey + " from " +  window.event.fromElement
</SCRIPT>

<SCRIPT ID=CurveScript LANGUAGE=vbscript>
</SCRIPT>

<BODY bgcolor=#e6e6e6 style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small" scroll=no>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM0_Template 2D" style="DISPLAY:
 none">StepsCount = 300
xMin = -2
xMax = 2

function y(x)
  y = 0.0
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID=CURVESCRIPT_2D_PARAM0_Sine style="DISPLAY:
 none">StepsCount = 300
xMin = -2
xMax = 2

function y(x)
  y = sin(x)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM0_Cosine" style="DISPLAY:
 none">StepsCount = 300
xMin = -2
xMax = 2

function y(x)
  y = cos(x)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID=CURVESCRIPT_2D_PARAM0_Tangent style="DISPLAY:
 none">StepsCount = 300
xMin = -2
xMax = 2

function y(x)
  y = tan(x)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID=CURVESCRIPT_2D_PARAM0_Arctangent style="DISPLAY:
 none">StepsCount = 300
xMin = -2
xMax = 2

function y(x)
  y = atn(x)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM0_Secant: Sec(X) = 1 / Cos(X)" style="DISPLAY:
 none">StepsCount = 300
xMin = 0
xMax = 10

function y(x)
  y = 1 / Cos(X)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM0_Cosecant: Cosec(X) = 1 / Sin(X)" style="DISPLAY:
 none">StepsCount = 300
xMin = 0.1
xMax = 10

function y(x)
  y = 1 / Sin(X)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM0_Cotangent: Cotan(X) = 1 / Tan(X)" style="DISPLAY:
 none">StepsCount = 300
xMin = 0.1
xMax = 10

function y(x)
  y = 1 / tan(X)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM0_Gauss: sqr(2)*exp(-x*x/2)" style="DISPLAY:
 none">StepsCount = 300
xMin = -2
xMax = 2

function y(x)
  y = sqr(2)*exp(-x*x/2)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM0_Integer portion 1" style="DISPLAY:
 none">StepsCount = 600
xMin = -2
xMax = 2

function y(x)
  y = fix(x)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM0_Integer portion 2" style="DISPLAY:
 none">StepsCount = 600
xMin = -2
xMax = 2

dim yOld
yOld = 0
function y(x)
  y = fix(x)
  if yOld < y then PenUp = TRUE
  yOld = y
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM0_Natural logarithm " style="DISPLAY:
 none">StepsCount = 300
xMin = 0.1
xMax = 10

function y(x)
  y = log(x)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID=CURVESCRIPT_2D_PARAM0_Exp style="DISPLAY:
 none">StepsCount = 300
xMin = -5
xMax = +5

function y(x)
  y = exp(x)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM0_Random number" style="DISPLAY:
 none">StepsCount = 300
xMin = -2
xMax = 2

function y(x)
  y = Rnd
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM0_Square root" style="DISPLAY:
 none">StepsCount = 300
xMin = 0
xMax = 10

function y(x)
  y = sqr(x)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM0_Line: a*x + b"
 style="DISPLAY: none">StepsCount = 300
xMin = -2
xMax = 2

dim a,b
a = 0.2
b = 1

function y(x)
  y = a*x + b
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM0_Parabola: a*x*x + b*x + c"
 style="DISPLAY: none">StepsCount = 300
xMin = -5
xMax = +5

dim a,b,c
a = 1
b = 0
c = -1

function y(x)
  y = a*x*x + b*x + c
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_3D_PARAM0_Template 3D" style="DISPLAY:
 none">StepsCount = 300
xMin = -2
xMax = 2

function y(x)
  y = 0.0
end function

function z(x)
  z = 0
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID=CURVESCRIPT_3D_PARAM0_Circle style="DISPLAY:
 none">StepsCount = 300
xMin = 0
xMax = 2*Pi

function y(x)
  y = sin(x)
end function

function z(x)
  z = cos(x)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID=CURVESCRIPT_3D_PARAM0_Ellipse style="DISPLAY:
 none">StepsCount = 300
xMin = 0
xMax = 2*Pi

function y(x)
  y = 2 * sin(x)
end function

function z(x)
  z = cos(x)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_3D_PARAM0_Spiral"  style="DISPLAY:
 none">StepsCount = 300
xMin = 0
xMax = 10

function y(x)
  y = x*sin(3*x)
end function

function z(x)
  z = x*cos(3*x)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Template 2D, Parametric form" style="DISPLAY:
 none">StepsCount = 300
tMin = 0
tMax = 2 * Pi

function x(t)
  x = t
end function

function y(t)
  y = 0.0
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Circle" style="DISPLAY:
 none">StepsCount = 300
tMin = 0
tMax = 2*Pi

function x(t)
  x = Sin(t)
end function

function y(t)
  y = Cos(t)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Arc" style="DISPLAY:
 none">StepsCount = 300
tMin = Pi/4
tMax = 6*Pi/4

function x(t)
  x = Sin(t)
end function

function y(t)
  y = Cos(t)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Ellipse" style="DISPLAY:
 none">StepsCount = 300
tMin = 0
tMax = 2*Pi

function x(t)
  x = 2*Sin(t)
end function

function y(t)
  y = Cos(t)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Spiral" style="DISPLAY:
 none">StepsCount = 300
tMin = 0
tMax = 2*Pi

function x(t)
  x =  t/3 * Sin(3*t)
end function

function y(t)
  y = t/3 * Cos(3*t)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Astroid" style="DISPLAY:
 none">StepsCount = 300
tMin = 0
tMax = 2*Pi

dim a
a = 3

function x(t)
  x =  a*Cos(t)^3
end function

function y(t)
  y = a*Sin(t)^3
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Cycloid" style="DISPLAY:
 none">StepsCount = 300
tMin = -8
tMax = 8

dim a, h
a = 1
h = 1.5

function x(t)
  x = a*t - h*Sin(t)
end function

function y(t)
  y = a - h*Cos(t)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Set of Cycloids(a)" style="DISPLAY:
 none">StepsCount = 300
tMin = -8
tMax = 8
GraphicsCount = 15

dim a, h
a = 1
h = 1.5

function x(t)
  a = 1 + GraphicNumber / 4
  x = a*t - h*Sin(t)
end function

function y(t)
  a = 1 + GraphicNumber / 4
  y = a - h*Cos(t)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Set of Cycloids(h)" style="DISPLAY:
 none">StepsCount = 300
tMin = -8
tMax = 8
GraphicsCount = 15

dim a, h
a = 1
h = 1.5

function x(t)
  h = 1 + GraphicNumber / 4
  x = a*t - h*Sin(t)
end function

function y(t)
  h = 1 + GraphicNumber / 4
  y = a - h*Cos(t)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Epicycloid" style="DISPLAY:
 none">StepsCount = 500
tMin = -16
tMax = 16
dim a, b
a = 8
b = 5
function x(t)
 x = ((a+b)*cos(t)-b*cos((a/b+1)*t))/5
end function

function y(t)
  y =((a+b)*sin(t)-b*sin((a/b+1)*t))/5
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Epitrochoid" style="DISPLAY:
 none">StepsCount = 500
tMin = -16
tMax = 16
dim a, b, c
a = 5
b = 3
c = 5
function x(t)
 x=((a+b)*cos(t) - c*cos((a/b +1)*t))/5
end function

function y(t)
  y=((a+b)*sin(t)-c*sin((a/b +1)*t)) / 5
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Evolventa" style="DISPLAY:
 none">StepsCount = 300
tMin = - Pi / 5
tMax = PI / 5

dim k
k = 1

function x(t)
  x = k * (cos(t)+ t * Sin(t))
end function

function y(t)
  y = k * (sin(t)- t * cos(t))
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Set of Evolventas" style="DISPLAY:
 none">StepsCount = 300
tMin = - Pi / 4.4
tMax = PI / 4.4
GraphicsCount = 30

dim k, dt
k = 1

function x(t)
  dt = GraphicNumber*Pi/15
  x = k * (cos(t + dt)+ t * Sin(t + dt))
end function

function y(t)
  dt = GraphicNumber * Pi/15
  y = k*(sin(t + dt)- t*cos(t + dt))
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Folium of Descartes" style="DISPLAY:
 none">StepsCount = 800
tMin = -19
tMax = 20
dim a
a = 1

function x(t)
 x = 3*a*t/(1 + t^3)
end function

function y(t)
  y = 3*a*t*t/(1 + t^3)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Hyperbola" style="DISPLAY:
 none">StepsCount = 300
tMin = -1.6
tMax = 4.8
dim a, b, xOld
a = 1
b = 1

function x(t)
  x = a * 1/cos( t)
  if (xOld * x) < 0 then PenUp = TRUE
  xOld = x
end function

function y(t)
  y = b * tan(t)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Hypocycloid" style="DISPLAY:
 none">StepsCount = 300
tMin = 0
tMax = 6*Pi
dim a, b, xOld
a = 5
b = 3

function x(t)
  x = (a - b)*cos(t) + b*cos((a/b -1)*t)
end function

function y(t)
  y = (a - b)*sin(t) - b*sin((a/b -1)*t)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Limacon of Pascal" style="DISPLAY:
 none">StepsCount = 300
tMin = 0
tMax = 2*Pi
dim a, l

a = 2
l = 1

function x(t)
 x = a*cos(t)*cos(t) + l*cos(t)
end function

function y(t)
  y = a*sin(t)*cos(t) + l*sin(t)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Set of Limacons of Pascal" style="DISPLAY:
 none">StepsCount = 300
tMin = 0
tMax = 2*Pi

GraphicsCount = 15

dim a, l
a = 0
l = 1

function x(t)
 a = GraphicNumber/7
 x = a*cos(t)*cos(t) + l*cos(t)
end function

function y(t)
  a = GraphicNumber/7
  y = a*sin(t)*cos(t) + l*sin(t)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Plateau Curves" style="DISPLAY:
 none">StepsCount = 300
tMin = 0.1
tMax = 3.3
dim a, m, n
a = 1
m = 5
n = 3

function x(t)
 x = a*sin((m+n)*t) /sin((m-n)*t)
end function

function y(t)
  y = 2*a*sin(m*t)*sin(n*t)/sin((m-n)*t)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Tricuspoid" style="DISPLAY:
 none">StepsCount = 300
tMin = 0
tMax = 2*Pi
dim a
a = 1

function x(t)
  x = a*(2*cos(t)+cos(2*t))
end function

function y(t)
  y = a*(2*sin(t)-sin(2*t))
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_2D_PARAM1_Witch of Agnesi" style="DISPLAY:
 none">StepsCount = 300
tMin = -5
tMax = 5
dim a
a = 1

function x(t)
  x = a*t
end function

function y(t)
  y = a/(1+t*t)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_3D_PARAM1_Template 3D, Parametric form" style="DISPLAY:
 none">StepsCount = 300
tMin = 0
tMax = 2 * Pi

function x(t)
  x = t
end function

function y(t)
  y = 0.0
end function

function z(t)
  z = 0
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_3D_PARAM1_Spiral" style="DISPLAY:
 none">StepsCount = 300
tMin = 0
tMax = 2*Pi

function x(t)
  x = t
end function

function y(t)
  y = Sin(3*t)
end function

function z(t)
  z = Cos(3*t)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_3D_PARAM1_Set of Ellipses" style="DISPLAY:
 none">StepsCount = 300
tMin = 0
tMax = 2*Pi
dim a, b
GraphicsCount = 15

function x(t)
  a = GraphicNumber/5
  x = a*Cos(t)
end function

function y(t)
  b = 3 - GraphicNumber/5
  y = b*Sin(t)
end function

function z(t)
  z = GraphicNumber/5
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_3D_PARAM1_Set of Cycloids(a)" style="DISPLAY:
 none">StepsCount = 300
tMin = -8
tMax = 8
GraphicsCount = 15

dim a, h
a = 1
h = 1.5

function x(t)
  a = 1 + GraphicNumber / 4
  x = a*t - h*Sin(t)
end function

function y(t)
  a = 1 + GraphicNumber / 4
  y = a - h*Cos(t)
end function

function z(t)
  z = GraphicNumber/5
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_3D_PARAM1_Set of Hyperboloids(a)" style="DISPLAY:
 none">StepsCount = 150
tMin = -4
tMax = 4
GraphicsCount = 20

dim p, q, dy
p = 3
q = 1

function x(t)
  x=t
end function

function y(t)
  dy=GraphicNumber-GraphicsCount/2
  y = dy/4
end function

function z(t)
  dy = GraphicNumber-GraphicsCount/2
  z = t*t/(2*p)-(dy/4)*(dy/4)/(2*q)
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_3D_PARAM1_Graftal" style="DISPLAY:
 none">StepsCount = 7000
tMin = -5
tMax = 5

dim i,j, k, a1, b1, c, bPenUp, Step1
dim x1, y1, z1, x2, y2, z2
Redim a1(3, 2, 3)
Redim b1(99)
bPenUp = TRUE
x1=0
y1=0
z1=0
x2=0
y2=0
z2=0
Step1 = 0

for i = 0 to 3
  for j = 0 to 2
    for k = 0 to 3
       a1(i, j, k) = 0
     next
  next
next

a1(0, 1, 1) = 20
a1(1, 0, 0) = 85
a1(1, 1, 1) = 85
a1(1, 1, 2) = 11
a1(1, 1, 3) = 70
a1(1, 2, 1) = -8 '// 0
a1(1, 2, 2) = 85
a1(2, 0, 0) = 31
a1(2, 0, 1) = -41
a1(2, 1, 0) = 10
a1(2, 1, 1) = 21
a1(2, 1, 3) = 21
a1(2, 2, 2) = 30
a1(3, 0, 0) = -29
a1(3, 0, 1) = 40
a1(3, 1, 0) = 10
a1(3, 1, 1) = 19
a1(3, 1, 3) = 56
a1(3, 2, 2) = 30

sub InitArB1
    for i = 0 to 99
      b1(i) = fix(10*rnd(10))
      'b1(i) = 1
      if b1(i) > 3 then b1(i) = 1
    next
end sub

function elem(n)
  c = b1(Step1)
  elem = (a1(c,n,0)*x1 + a1(c,n,1)*y1 + a1(c,n,2)*z1)/100 + a1(c,n,3)
end function

dim xOld
function x(t)
  if (bPenUp) then
   if Step1 > 99 then Step1 = 0
   if Step1 = 0 then InitArB1
   x2 = elem(0)
   x = elem(2) - elem(0)
   xOld = x
  else
   x = xOld
  end if

  x = x/100
end function

function y(t)
  if (bPenUp) then
   y2 = elem(1)
  end if

   y = y2

   y = y/100
end function

function z(t)
  if (bPenUp) then
   z2 = elem(2)
   PenUp = TRUE
   Step1 = Step1 + 1
  end if

  bPenUp = not bPenUp

  x1 = x2
  y1 = y2
  z1 = z2

  z = 0
end function
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="CURVESCRIPT_3D_PARAM1_Graftal 1" style="DISPLAY:
 none">StepsCount = 7000
tMin = -5
tMax = 5

dim i,j, k, a1, b1, c, bPenUp, Step1
dim x1, y1, z1, x2, y2, z2
Redim a1(3, 2, 3)
Redim b1(99)
bPenUp = TRUE
x1=0
y1=0
z1=0
x2=0
y2=0
z2=0
Step1 = 0

for i = 0 to 3
  for j = 0 to 2
    for k = 0 to 3
       a1(i, j, k) = 0
     next
  next
next

a1(0, 1, 1) = 20
a1(1, 0, 0) = 85
a1(1, 1, 1) = 85
a1(1, 1, 2) = 11
a1(1, 1, 3) = 70
a1(1, 2, 1) = -8 '// 0
a1(1, 2, 2) = 85
a1(2, 0, 0) = 31
a1(2, 0, 1) = -41
a1(2, 1, 0) = 10
a1(2, 1, 1) = 21
a1(2, 1, 3) = 21
a1(2, 2, 2) = 30
a1(3, 0, 0) = -29
a1(3, 0, 1) = 40
a1(3, 1, 0) = 10
a1(3, 1, 1) = 19
a1(3, 1, 3) = 56
a1(3, 2, 2) = 30

sub InitArB1
    for i = 0 to 99
      b1(i) = fix(10*rnd(10))
      'b1(i) = 1
      if b1(i) > 3 then b1(i) = 1
    next
end sub

function elem(n)
  c = b1(Step1)
  elem = (a1(c,n,0)*x1 + a1(c,n,1)*y1 + a1(c,n,2)*z1)/100 + a1(c,n,3)
end function

dim xOld
function x(t)
  if (bPenUp) then
   if Step1 > 99 then Step1 = 0
   if Step1 = 0 then InitArB1
   x2 = elem(0)
   x = elem(2) - elem(0)
   xOld = x
  else
   x = xOld
  end if

  x = x/100
end function

function y(t)
  if (bPenUp) then
   y2 = elem(1)
   y = y2
  else
   y = y2 + 0.4
  end if

  y = y/100
end function

function z(t)
  if (bPenUp) then
   z2 = elem(2)
   PenUp = TRUE
   Step1 = Step1 + 1
  end if

  bPenUp = not bPenUp

  x1 = x2
  y1 = y2
  z1 = z2

  z = 0
end function
</SCRIPT>

<!-- StBase: Plugin base module (Header, Stop, Star, About, resize ...)-->
<OBJECT height=19 id=StBase name=StBase
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 101"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StBase.htm"></OBJECT>

<!-- StTC -->
<OBJECT height=0 id=StTC name=StTC
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 104"
type=text/x-scriptlet width=0><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StTC.htm"></OBJECT>

<!-- StToolBar -->
<OBJECT height=24 id=StToolBar name=StToolBar
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 21px; Z-INDEX: 102"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StToolBar.htm"></OBJECT>

<!-- StText -->
<OBJECT height=300 id=StText name=StText
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 45px; Z-INDEX: 103"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StText.htm"></OBJECT>

<!------------------ Specific Controls -------------------------->
<SELECT id=Combo name=Combo
    style="FONT-FAMILY:
     sans-serif; FONT-SIZE: xx-small;
     LEFT: 0px;
     POSITION: absolute;
     TOP: 0px;
     WIDTH: 0px;
     Z-INDEX: 105;
    multiple;: 105"
    accesskey=c>
</SELECT>

</BODY>
</HTML>


Examples - Internet Palette Scripts - D&&

D&&

Internet Palette Scripts Example

<HTML>
<HEAD><TITLE></TITLE>
<META content="text/html; charset=unicode" http-equiv=Content-Type>

<SCRIPT ID=Main Name="Main" LANGUAGE=vbscript>
<!--
option Explicit

'// ToolBar's ToolTips
const TT_TLB_LOG = "Logged Drawing"
const TT_TLB_INCLUDEVERTICES = "Include Vertices in Tree"
const TT_TLB_SHOWVERTICEX = "Show selected vertex location"
const TT_TLB_CLEARVERTICES = "Clear Vertices Marks"
const TT_TLB_DIGITS_AFTER_DECIMAL = "Digits after decimal point"
const TT_TLB_Help = "Help"
const TT_TLB_TYPE = "Graphic's Type"
const TT_TLB_DELETE = "Delete"
const TT_TLB_CALC = "Calculator"

dim ItemName, ItemID, ItemSubID
ItemName = ""
ItemID = 0
ItemID = 0

Dim sRootName, sVertexName

'/////////////////// Specific part //////////////////////////
Sub window_onload

    StBase.ToolName = "DrawingView"
    StBase.ToolVer = "1.01"

    '// Set initial sizes
    StBase.ResizeAllScriplets

    '// Init constants
    sRootName = StTC.ROOT_NAME '// Root
    sVertexName = StTC.VERTEX_NAME '// Vertex

    '// Specific Controls
    '// Fill ToolBar
    InitToolBar
    window.setTimeout "InitCombo", 0

    StTC.CreateEvents(StTC.EventBeforeExit + StTC.EventSelectionChange)

    UpdateUI
End Sub

Sub window_onresize
    '// Resize all Scriptlets Controls
    StBase.ResizeAllScriplets
End Sub

Sub window_onhelp
    'StBase.Help
End Sub

'// InitToolBar
'//
sub InitToolBar

    '// Add Images
    With StToolBar.ImgList.ListImages
    .Clear
    .Add  ,"Log",		LoadPicture(StBase.ImagePath + "TLB_Log.bmp")
    .Add  ,"Vertices",	LoadPicture(StBase.ImagePath + "TLB_Vertices.bmp")
    .Add  ,"ShowVertex",LoadPicture(StBase.ImagePath + "TLB_ShowVertex.bmp")
    .Add  ,"ClearMarks",LoadPicture(StBase.ImagePath + "TLB_ClearMarks.bmp")
    .Add  ,"Precision", LoadPicture(StBase.ImagePath + "TLB_Precision.bmp")
    .Add  ,"Delete",	LoadPicture(StBase.ImagePath + "TLB_Delete.bmp")
    '.Add  ,"Help",		LoadPicture(StBase.ImagePath + "TLB_Help.bmp")
    .Add  ,"Calculator",LoadPicture(StBase.ImagePath + "TLB_Calculator.bmp")
    StToolBar.SetImageList
    End With

    '// Add Buttons
    With StToolBar.ToolBar.Buttons
    .Add (, "Log",,,"Log").ToolTipText = TT_TLB_LOG
    .Add (, "Vertices",, StToolBar.tbrCheck, "Vertices").ToolTipText = TT_TLB_INCLUDEVERTICES
    .Add (, "ShowVertex", ,,"ShowVertex"	).ToolTipText = TT_TLB_SHOWVERTICEX
    .Add (, "ClearMarks", ,,"ClearMarks"	).ToolTipText = TT_TLB_CLEARVERTICES
    .Add  ,	, , StToolBar.tbrSeparator
    .Add (, "Precision", , StToolBar.tbrDropDown, "Precision").ToolTipText = TT_TLB_DIGITS_AFTER_DECIMAL
    .Add (, "Calculator",,StToolBar.tbrCheck,"Calculator").ToolTipText = TT_TLB_CALC
    .Add  ,  "Combo",,StToolBar.tbrPlaceholder
    .Add (, "Delete",,, "Delete"	).ToolTipText = TT_TLB_DELETE
    '.Add (, "Help", ,,"Help").ToolTipText = TT_TLB_Help
    .Add  , , , StToolBar.tbrSeparator
     End With
    StToolBar.ToolBar.Buttons("Vertices").value = 1
    StToolBar.ToolBar.Buttons("Combo").Width = 130

    '// Fill Precision Menu
    With StToolBar.ToolBar.Buttons("Precision")

    if StTC.objApp.Drawings.count <> 0 then
        .ButtonMenus.Add( ,,"As Drawing").Enabled = 0
        .ButtonMenus.Add ,,"0.00"
        StObjectBase.DigitsAfterDecimal = StTC.objApp.ActiveDrawing.Properties("$LUPREC")
    else
        .ButtonMenus.Add ,,"As Drawing"
        .ButtonMenus.Add( ,,"0.00").Enabled = 0
        StObjectBase.DigitsAfterDecimal = 2
    end if

    .ButtonMenus.Add ,,"0.0000"
    .ButtonMenus.Add ,,"0.000000"
    .ButtonMenus.Add ,,"0.00000000"
    .ButtonMenus.Add ,"Key Max Precision (15)","Max Precision (15)"
     End With

end sub '//InitToolBar

sub UpdateUI

    dim bDrawing, bVertexSelected, bGraphicSelected
    bDrawing = false
    bVertexSelected = false
    bGraphicSelected = false

    bDrawing = (StTC.objApp.Drawings.count <> 0)
    bVertexSelected = (ItemName = sVertexName)
    bGraphicSelected = StObjectBase.IsGraphic(ItemName)

    '// Update ToolBar
    with StToolBar.ToolBar
        .Buttons("Log").Enabled			= bDrawing
        .Buttons("Vertices").Enabled	= bDrawing
        .Buttons("ShowVertex").Enabled	= bDrawing and bVertexSelected
        .Buttons("ClearMarks").Enabled	= bDrawing
        .Buttons("Precision").Enabled	= bDrawing
        .Buttons("Delete").Enabled		= bDrawing and (bVertexSelected	or bGraphicSelected)
        '.Buttons("Help").Enabled		= true
        .Buttons("Calculator").Enabled	= true
     end with

    '// Update StDrawingTree
     if (not bDrawing) then
         StDrawingTree.ClearContent
         StObjectBase.ClearContent
    end if
end sub

'// InitCombo
'//
sub InitCombo

    dim Rms, Item, i
    Set Rms = StTC.objApp.RegenMethods
    for i = 0 to (Rms.Count - 1)
        set item = document.createElement("Option")
        item.text = UCase(Rms(i).Name)
        item.value = item.text
        Combo.add(item)
        set item = nothing
    Next

    With Combo
      .style.Width = StToolBar.ToolBar.Buttons("Combo").Width
      .style.Top = StToolBar.ToolBar.Buttons("Combo").Top + StBase.PixToI(StToolBar.style.top) + 1
      .style.Left = StToolBar.ToolBar.Buttons("Combo").Left
      .style.fontSize = 12
     End With
end sub '//InitCombo

sub StTCEvent
    UpdateUI
    StTC.ReleaseEvent(StTC.EventsFlag) '// Release All Events
end sub

sub DoDwgLog(bSaveNodeIndex)
    dim OldIndex
    if (bSaveNodeIndex) then OldIndex = StDrawingTree.LastSelNodeIndex
    StDrawingTree.DoDwgLog false, true, StToolBar.ToolBar.Buttons("Vertices").value, Combo.value
    if (bSaveNodeIndex) then StDrawingTree.LastSelNodeIndex = OldIndex
    StDrawingTree.NodeClick
end sub

'// Accelerators routine
'//		Ctrl - L	Toggle Java/Basic
'Sub StDrawingTree_onkeydown
'	Alert 1
'	TranslateAccelerators(StDrawingTree.event)
'End Sub

'Sub Document_onkeydown
'	TranslateAccelerators(window.event)
'End Sub

'sub TranslateAccelerators(e)
'	if e.ctrlKey then
'		select case Chr(e.KeyCode)
'		    case "L"
'				if StToolBar.ToolBar.Buttons("Log").Enabled then
'					StDrawingTree.DoDwgLog false, true, StToolBar.ToolBar.Buttons("Vertices").value, Combo.value
'					StDrawingTree.NodeClick
'					UpdateUI
'				end if
'		end select
'	end if
'end sub

-->

-->
</SCRIPT>

<SCRIPT language="vbscript" for=StToolBar event="onscriptletevent(eventname, eventdata)">
'// event From StToolBar
    select case eventname
        case "ButtonClick"
            select case eventdata.Key
                case "Log", "Vertices"
                    DoDwgLog(false)

                case "ShowVertex"
                    StDrawingTree.NodeDblClick

                case "ClearMarks"
                    StTC.objApp.ActiveDrawing.Views.Item(0).Refresh

                case "Delete"
                    StDrawingTree.NodeDelete

                case "Help"
                    'StBase.Help

                case "Calculator"
                    if StCalculator.IsShowable then
                        StCalculator.Hide(StCalculator)
                    else
                        StCalculator.Show(StCalculator)
                    end if
                    StCalculator.IsShowable = not StCalculator.IsShowable
                    window_onresize

             end select

        case "MenuClick"

            Select Case eventdata.Text
                case "As Drawing"
                    StObjectBase.DigitsAfterDecimal = StTC.objApp.ActiveDrawing.Properties("$LUPREC")
                case "0.00"
                    StObjectBase.DigitsAfterDecimal = 2
                case "0.0000"
                    StObjectBase.DigitsAfterDecimal = 4
                case "0.000000"
                    StObjectBase.DigitsAfterDecimal = 6
                case "0.00000000"
                    StObjectBase.DigitsAfterDecimal = 8
                case "Max Precision (15)"
                    StObjectBase.DigitsAfterDecimal = 15
                end select

                dim item
                for each item in StToolbar.Toolbar.Buttons("Precision").ButtonMenus
                    item.Enabled = 1
                next
                eventdata.Enabled = 0

                StDrawingTree.NodeClick
            end select

    UpdateUI
</SCRIPT>

<SCRIPT language="vbscript" for=StDrawingTree event="onscriptletevent(eventname, Node)">
'// event From StDrawingTree

    '// Check Object
    if not StObjectBase.ObjectExist(StDrawingTree.ItemName(Node), StDrawingTree.ItemID(Node)) then
        dim sMessage, iRes
        sMessage = "Object: " + ItemName + " not found." + vbCrLf
        sMessage = sMessage + "Drawing was changed." + vbCrLf
        sMessage = sMessage + "Do you want to relogge drawing?"
        iRes = MsgBox(sMessage, vbYesNo + vbInformation, "Plugin " + PLUGIN_NAME + " Warning")
        if (iRes = vbYes) then
            window.setTimeout "DoDwgLog(true)", 200
        end if
        exit sub
     end if

    ItemName = StDrawingTree.ItemName(Node)
    ItemID = StDrawingTree.ItemID(Node)
    ItemSubID = StDrawingTree.ItemSubID(Node)

    '// Set Statistic for Root
    if ItemName = sRootName then
        ItemID = StDrawingTree.GraphicsCount
        ItemSubID = StDrawingTree.VerticesCount
    end if

    select case eventname

        case "TreeView_Click"
            call StObjectBase.ShowObjectInfo(ItemName, ItemID, ItemSubID)

        case "TreeView_DblClick"
            '// Set Statistic for Root
            if ItemName <> sRootName then
                call StObjectBase.DisplayObject(ItemName, ItemID, ItemSubID)
            else
                window.setTimeout "StDrawingTree.SelectAll", 200
            end if

        case "TreeView_KeyUp"
            if (StDrawingTree.LastSelNodeIndex <> Node.Index) then
                call StObjectBase.ShowObjectInfo(ItemName, ItemID, ItemSubID)
            end if
    end select

    UpdateUI
</SCRIPT>

<SCRIPT language="vbscript" for=StObjectBase event="onscriptletevent(eventname, eventdata)">
'// event From StObjectBase
    select case eventname

        case "ListView_Click"
            if (StCalculator.IsShowable) then StCalculator.CalculatorVal = eventdata

    end select
    'UpdateUI
</SCRIPT>

<SCRIPT language="vbscript" for=StTC event="onscriptletevent(eventname, eventdata)">
'// event From StTC
    window.setTimeout "StTCEvent", 0

</SCRIPT>

<SCRIPT language="vbscript" for=StBase event="onscriptletevent(eventname, eventdata)">
'// event From StBase
    select case eventname

        '// Start
        case "ShowAll"
            Combo.style.display = ""
            'StTC.CreateEvents(StTC.EventBeforeExit + StTC.EventSelectionChange)

        '// Stop
        case "HideAll"
            Combo.style.display = "none"
            StTC.DeleteEvents
    end select
    UpdateUI
</SCRIPT>

<SCRIPT ID=clientEventHandlersVBS LANGUAGE=vbscript>
<!--
Sub Combo_onchange
    if StDrawingTree.DoDwgLog(false, true, StToolBar.ToolBar.Buttons("Vertices").value, Combo.value) then
        StDrawingTree.NodeClick
        UpdateUI
    end if
    window.status = Combo.value
End Sub
-->
</SCRIPT>

</HEAD>
<BODY bgcolor=#e6e6e6 style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small" scroll=no>

<!-- StBase -->
<OBJECT height=19 id=StBase name=StBase
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 102"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StBase.htm"></OBJECT>

<!-- StToolBar -->
<OBJECT height=24 id=StToolBar name=StToolBar
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 21px; Z-INDEX: 103"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StToolBar.htm"></OBJECT>

<!-- StDrawingTree -->
<OBJECT height=400 id=StDrawingTree name=StDrawingTree
style="BACKGROUND-COLOR: silver; DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 45px; Z-INDEX: 104"
type=text/x-scriptlet width=300><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StDrawingTree.htm"></OBJECT>

<!-- StObjectBase -->
<OBJECT height=190 id=StObjectBase name=StObjectBase
style="BACKGROUND-COLOR: silver; BORDER-BOTTOM-COLOR: white; BORDER-TOP-COLOR: white; DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 330px; Z-INDEX: 104"
type=text/x-scriptlet width=300><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StObjectBase.htm"></OBJECT>

<!-- StCalculator -->
<OBJECT height=180 id=StCalculator name=StCalculator
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 515px; Z-INDEX: 104"
type=text/x-scriptlet width=267><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StCalculator.htm"></OBJECT>

<!-- StTC -->
<OBJECT height=0 id=StTC name=StTC
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 300px; Z-INDEX: 104"
type=text/x-scriptlet width=0><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StTC.htm"></OBJECT>

<!------------------ Specific Controls -------------------------->
<SELECT id=Combo name=Combo
    style="FONT-FAMILY:
     sans-serif; FONT-SIZE: xx-small;
     LEFT: 0px;
     POSITION: absolute;
     TOP: 0px;
     WIDTH: 0px;
     Z-INDEX: 105;
    multiple;: 105"  >
    <OPTION selected value="ALL TYPES">ALL TYPES</OPTION>
    <OPTION value="ARC">ARC</OPTION>
    <OPTION value="BLOCKS">BLOCK</OPTION>
    <OPTION value="CIRCLE">CIRCLE</OPTION>
    <OPTION value="INSERT">INSERT</OPTION>
    <OPTION value="GRAPHIC">GRAPHIC</OPTION>
    <OPTION value="OLE">OLE</OPTION>
    <OPTION value="SURFACE">SURFACE</OPTION>
    <OPTION value="TEXT">TEXT</OPTION>
    <OPTION value="UCS">UCS</OPTION>
    <OPTION value="VIEWPORT">VIEWPORT</OPTION>
</SELECT>

</BODY>
</HTML>


Examples - Internet Palette Scripts - Demo%20ScreenCam.htm

Demo%20ScreenCam.htm

Internet Palette Scripts Example

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
<!-- saved from url=(0063)http://www.softdevspb.com/plugins/VVeselov/Demo%20ScreenCam.htm -->
<HTML xmlns="http://www.w3.org/TR/REC-html40" xmlns:v =
"urn:schemas-microsoft-com:vml" xmlns:o =
"urn:schemas-microsoft-com:office:office" xmlns:w =
"urn:schemas-microsoft-com:office:word"><HEAD>
<META content="text/html; charset=windows-1251" http-equiv=Content-Type>
<META content=Word.Document name=ProgId>
<META content="MSHTML 5.00.2920.0" name=GENERATOR>
<META content="Microsoft Word 9" name=Originator><LINK
href="./Demo%20ScreenCam_files/filelist.xml" rel=File-List><LINK
href="./Demo%20ScreenCam_files/editdata.mso" rel=Edit-Time-Data><LINK
href="./Demo%20ScreenCam_files/oledata.mso" rel=OLE-Object-Data><!--[if !mso]>
<STYLE>v\:* {
    BEHAVIOR: url(#default#VML)
}
o\:* {
    BEHAVIOR: url(#default#VML)
}
w\:* {
    BEHAVIOR: url(#default#VML)
}
.shape {
    BEHAVIOR: url(#default#VML)
}
</STYLE>
<![endif]--><!--[if gte mso 9]><xml>
 <o:DocumentProperties>
  <o:Author>Veselov</o:Author>
  <o:LastAuthor>Veselov</o:LastAuthor>
  <o:Revision>33</o:Revision>
  <o:TotalTime>41</o:TotalTime>
  <o:Created>2000-02-06T20:05:00Z</o:Created>
  <o:LastSaved>2000-02-06T20:46:00Z</o:LastSaved>
  <o:Pages>3</o:Pages>
  <o:Words>42</o:Words>
  <o:Characters>240</o:Characters>
  <o:Company>IMSI</o:Company>
  <o:Lines>2</o:Lines>
  <o:Paragraphs>1</o:Paragraphs>
  <o:CharactersWithSpaces>294</o:CharactersWithSpaces>
  <o:Version>9.2812</o:Version>
 </o:DocumentProperties>
</xml><![endif]-->
<STYLE>P.MsoNormal {
    FONT-FAMILY: "Times New Roman"; FONT-SIZE: 12pt; MARGIN: 0cm 0cm 0pt; mso-style-parent: ""; mso-pagination: widow-orphan; mso-fareast-font-family: "Times New Roman"; mso-bidi-font-family: "Times New Roman"
}
LI.MsoNormal {
    FONT-FAMILY: "Times New Roman"; FONT-SIZE: 12pt; MARGIN: 0cm 0cm 0pt; mso-style-parent: ""; mso-pagination: widow-orphan; mso-fareast-font-family: "Times New Roman"; mso-bidi-font-family: "Times New Roman"
}
DIV.MsoNormal {
    FONT-FAMILY: "Times New Roman"; FONT-SIZE: 12pt; MARGIN: 0cm 0cm 0pt; mso-style-parent: ""; mso-pagination: widow-orphan; mso-fareast-font-family: "Times New Roman"; mso-bidi-font-family: "Times New Roman"
}
H1 {
    FONT-FAMILY: Arial; FONT-SIZE: 16pt; MARGIN: 12pt 0cm 3pt; mso-pagination: widow-orphan; mso-style-next: Normal; mso-outline-level: 1; mso-font-kerning: 16.0pt
}
H3 {
    FONT-FAMILY: Arial; FONT-SIZE: 13pt; MARGIN: 12pt 0cm 3pt; mso-pagination: widow-orphan; mso-style-next: Normal; mso-outline-level: 3
}
A:link {
    COLOR: blue; TEXT-DECORATION: underline; text-underline: single
}
SPAN.MsoHyperlink {
    COLOR: blue; TEXT-DECORATION: underline; text-underline: single
}
A:visited {
    COLOR: purple; TEXT-DECORATION: underline; text-underline: single
}
SPAN.MsoHyperlinkFollowed {
    COLOR: purple; TEXT-DECORATION: underline; text-underline: single
}
DIV.Section1 {
    page: Section1
}
</STYLE>
</HEAD>
<BODY bgColor=#ebe9dd lang=EN-US link=blue style="tab-interval: 36.0pt"
vLink=purple>
<H1>Samples of using plug-ins in SCM format (ScreenCam)</SPAN></H1>
<DIV class=Section1>
<P class=MsoNormal><![if !supportEmptyParas]><![endif]>&nbsp;<o:p></o:p></P>
<P class=MsoNormal><![if !supportEmptyParas]><![endif]>&nbsp;<o:p></o:p></P>
<P class=MsoNormal><A
href="http://www.softdevspb.com/plugins/VVeselov/Demo%20ScreenCam.htm#_Selection_Info,_Drawing">Selection
Info, Drawing View</A></P>
<P class=MsoNormal><A
href="http://www.softdevspb.com/plugins/VVeselov/Demo%20ScreenCam.htm#_Curve_Lab">Curve<SPAN
style="mso-ansi-language: RU"> </SPAN>lab</A><SPAN lang=RU
style="mso-ansi-language: RU"><o:p></o:p></SPAN></P>
<P class=MsoNormal><SPAN lang=RU style="mso-ansi-language: RU"><SPAN
style="mso-tab-count: 1">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
</SPAN><A
href="http://www.softdevspb.com/plugins/VVeselov/Demo%20ScreenCam.htm#_Creating_plane_curves">Creating
plane curves</A><o:p></o:p></SPAN></P>
<P class=MsoNormal style="TEXT-INDENT: 36pt"><SPAN lang=RU
style="mso-ansi-language: RU"><A
href="http://www.softdevspb.com/plugins/VVeselov/Demo%20ScreenCam.htm#_Curves_with_thickness">Curves
with thickness</SPAN></A><o:p></o:p></SPAN></P>
<P class=MsoNormal style="TEXT-INDENT: 36pt"><SPAN lang=RU
style="mso-ansi-language: RU"><A
href="http://www.softdevspb.com/plugins/VVeselov/Demo%20ScreenCam.htm#_Building Extrusion">Building
Extrusion using the defined path</A><o:p></o:p></SPAN></P>
<P class=MsoNormal style="TEXT-INDENT: 36pt"><SPAN lang=RU
style="mso-ansi-language: RU"><A
href="http://www.softdevspb.com/plugins/VVeselov/Demo%20ScreenCam.htm#_Creating a set">Creating
a set of curves as a basis for Loft operation</SPAN></P>
<P class=MsoNormal><A
href="http://www.softdevspb.com/plugins/VVeselov/Demo%20ScreenCam.htm#_Script_Lab">Script
Lab</A></P><!--- <p><font size="-1">Can't see scm-files? <a href="">Download ScreenCam player!</a></font></p>
 --->
<P class=MsoNormal><![if !supportEmptyParas]><![endif]>&nbsp;<o:p></o:p></P>
<P class=MsoNormal><![if !supportEmptyParas]><![endif]>&nbsp;<o:p></o:p></P>
<H1><A name=_Selection_Info,_Drawing></A>Selection Info, Drawing View</H1>
<P class=MsoNormal><!--[if gte vml 1]><v:shapetype id=_x0000_t75 coordsize =
"21600,21600" o:preferrelative = "t" filled = "f" stroked = "f" path =
"m@4@5l@4@11@9@11@9@5xe" o:spt = "75"><v:stroke joinstyle =
"miter"></v:stroke><v:formulas><v:f eqn =
"if lineDrawn pixelLineWidth 0 "></v:f><v:f eqn = "sum @0 1 0 "></v:f><v:f eqn =
"sum 0 0 @1 "></v:f><v:f eqn = "prod @2 1 2 "></v:f><v:f eqn =
"prod @3 21600 pixelWidth "></v:f><v:f eqn =
"prod @3 21600 pixelHeight "></v:f><v:f eqn = "sum @0 0 1 "></v:f><v:f eqn =
"prod @6 1 2 "></v:f><v:f eqn = "prod @7 21600 pixelWidth "></v:f><v:f eqn =
"sum @8 21600 0 "></v:f><v:f eqn = "prod @7 21600 pixelHeight "></v:f><v:f eqn =
"sum @10 21600 0 "></v:f></v:formulas><v:path o:extrusionok = "f"
gradientshapeok = "t" o:connecttype = "rect"></v:path><o:lock v:ext="edit"
aspectratio = "t"></o:lock></v:shapetype><v:shape id=_x0000_i1045
style="HEIGHT: 228pt; WIDTH: 304.2pt" o:ole="" type = "#_x0000_t75" coordsize =
"21600,21600"><v:imagedata o:title="" src =
"./Demo%20ScreenCam_files/image001.png"></v:imagedata></v:shape><![endif]--><![if !vml]><img border=0 width=406 height=304
src="./Demo%20ScreenCam_files/image002.jpg" v:shapes="_x0000_i1045"><![endif]><!--[if gte mso 9]><xml>
 <o:OLEObject Type="Embed" ProgID="PBrush" ShapeID="_x0000_i1045"
  DrawAspect="Content" ObjectID="_1011386222">
 </o:OLEObject>
</xml><![endif]--></P>
<P class=MsoNormal><A
href="http://www.softdevspb.com/plugins/VVeselov/Demo%20ScreenCam_files/SelInfo_DwgView.zip">SelInfo_DwgView.scm</A></P>
<P class=MsoNormal><![if !supportEmptyParas]><![endif]>&nbsp;<o:p></o:p></P>
<H1><A name=_Curve_Lab></A>Curve Lab</H1>
<P class=MsoNormal><![if !supportEmptyParas]><![endif]>&nbsp;<o:p></o:p></P>
<H3><A name=_Creating_plane_curves></A><SPAN lang=RU
style="mso-ansi-language: RU">Creating plane curves<o:p></o:p></SPAN></H3>
<P class=MsoNormal><!--[if gte vml 1]><v:shape id=_x0000_i1034
style="HEIGHT: 228pt; WIDTH: 304.2pt" o:ole="" type = "#_x0000_t75" coordsize =
"21600,21600"><v:imagedata o:title="" src =
"./Demo%20ScreenCam_files/image003.png"></v:imagedata></v:shape><![endif]--><![if !vml]><img border=0 width=406 height=304
src="./Demo%20ScreenCam_files/image004.jpg" v:shapes="_x0000_i1034"><![endif]><!--[if gte mso 9]><xml>
 <o:OLEObject Type="Embed" ProgID="PBrush" ShapeID="_x0000_i1034"
  DrawAspect="Content" ObjectID="_1011386223">
 </o:OLEObject>
</xml><![endif]--></P>
<P class=MsoNormal><A
href="http://www.softdevspb.com/plugins/VVeselov/Demo%20ScreenCam_files/Curve1_Flat.zip">Curve1_Flat.scm</A></P>
<P class=MsoNormal><![if !supportEmptyParas]><![endif]>&nbsp;<o:p></o:p></P>
<H3><A name=_Curves_with_thickness></A><SPAN lang=RU
style="mso-ansi-language: RU">Curves with thickness</SPAN></H3>
<P class=MsoNormal><!--[if gte vml 1]><v:shape id=_x0000_i1036
style="HEIGHT: 229.2pt; WIDTH: 304.2pt" o:ole="" type = "#_x0000_t75" coordsize
= "21600,21600"><v:imagedata o:title="" src =
"./Demo%20ScreenCam_files/image005.png"></v:imagedata></v:shape><![endif]--><![if !vml]><img border=0 width=406 height=306
src="./Demo%20ScreenCam_files/image006.jpg" v:shapes="_x0000_i1036"><![endif]><!--[if gte mso 9]><xml>
 <o:OLEObject Type="Embed" ProgID="PBrush" ShapeID="_x0000_i1036"
  DrawAspect="Content" ObjectID="_1011386224">
 </o:OLEObject>
</xml><![endif]--></P>
<P class=MsoNormal><A
href="http://www.softdevspb.com/plugins/VVeselov/Demo%20ScreenCam_files/Curve2_Thic.zip">Curve2_Thic.scm</A></P>
<P class=MsoNormal><![if !supportEmptyParas]><![endif]>&nbsp;<o:p></o:p></P>
<H3><A name="_Building Extrusion"></A><SPAN lang=RU
style="mso-ansi-language: RU">Building Extrusion using the defined
path</SPAN></H3>
<P class=MsoNormal><!--[if gte vml 1]><v:shape id=_x0000_i1043
style="HEIGHT: 228pt; WIDTH: 304.2pt" o:ole="" type = "#_x0000_t75" coordsize =
"21600,21600"><v:imagedata o:title="" src =
"./Demo%20ScreenCam_files/image007.png"></v:imagedata></v:shape><![endif]--><![if !vml]><img border=0 width=406 height=304
src="./Demo%20ScreenCam_files/image008.jpg" v:shapes="_x0000_i1043"><![endif]><!--[if gte mso 9]><xml>
 <o:OLEObject Type="Embed" ProgID="PBrush" ShapeID="_x0000_i1043"
  DrawAspect="Content" ObjectID="_1011386226">
 </o:OLEObject>
</xml><![endif]--></P>
<P class=MsoNormal><A
href="http://www.softdevspb.com/plugins/VVeselov/Demo%20ScreenCam_files/Curve3_Spiral.zip">Curve3_Spiral.scm</A></P>
<P class=MsoNormal><SPAN lang=RU style="mso-ansi-language: RU"><![if !supportEmptyParas]>&nbsp;<![endif]><o:p></o:p></SPAN></P>
<H3><A name="_Creating a set"></A><SPAN lang=RU
style="mso-ansi-language: RU">Creating a set of curves as a basis for Loft
operation</SPAN></H3>
<P class=MsoNormal><!--[if gte vml 1]><v:shape id=_x0000_i1038
style="HEIGHT: 227.4pt; WIDTH: 304.2pt" o:ole="" type = "#_x0000_t75" coordsize
= "21600,21600"><v:imagedata o:title="" src =
"./Demo%20ScreenCam_files/image009.png"></v:imagedata></v:shape><![endif]--><![if !vml]><img border=0 width=406 height=303
src="./Demo%20ScreenCam_files/image010.jpg" v:shapes="_x0000_i1038"><![endif]><!--[if gte mso 9]><xml>
 <o:OLEObject Type="Embed" ProgID="PBrush" ShapeID="_x0000_i1038"
  DrawAspect="Content" ObjectID="_1011386227">
 </o:OLEObject>
</xml><![endif]--></P>
<P class=MsoNormal><A
href="http://www.softdevspb.com/plugins/VVeselov/Demo%20ScreenCam_files/Curve4_Loft.zip">Curve<SPAN
lang=RU style="mso-ansi-language: RU">4_</SPAN>Loft<SPAN lang=RU
style="mso-ansi-language: RU">.</SPAN>scm</A><SPAN lang=RU
style="mso-ansi-language: RU"><o:p></o:p></SPAN></P>
<P class=MsoNormal><SPAN lang=RU style="mso-ansi-language: RU"><![if !supportEmptyParas]>&nbsp;<![endif]><o:p></o:p></SPAN></P>
<H1><A name=_Script_Lab></A>Script Lab </H1>
<P class=MsoNormal><!--[if gte vml 1]><v:shape id=_x0000_i1049
style="HEIGHT: 228pt; WIDTH: 304.2pt" o:ole="" type = "#_x0000_t75" coordsize =
"21600,21600"><v:imagedata o:title="" src =
"./Demo%20ScreenCam_files/image011.png"></v:imagedata></v:shape><![endif]--><![if !vml]><img border=0 width=406 height=304
src="./Demo%20ScreenCam_files/image012.jpg" v:shapes="_x0000_i1049"><![endif]><!--[if gte mso 9]><xml>
 <o:OLEObject Type="Embed" ProgID="PBrush" ShapeID="_x0000_i1049"
  DrawAspect="Content" ObjectID="_1011386228">
 </o:OLEObject>
</xml><![endif]--></P>
<P class=MsoNormal><A
href="http://www.softdevspb.com/plugins/VVeselov/Demo%20ScreenCam_files/ScriptLab.zip">ScriptLab.scm</A></P>
<P class=MsoNormal><![if !supportEmptyParas]><![endif]>&nbsp;<o:p></o:p></P>
<P class=MsoNormal><![if !supportEmptyParas]><![endif]>&nbsp;<o:p></o:p></P>
<P
class=MsoNormal><![if !supportEmptyParas]><![endif]>&nbsp;<o:p></o:p></P></DIV></BODY></HTML>


Examples - Internet Palette Scripts - S&&

S&&

Internet Palette Scripts Example

<HTML>
<HEAD>
<META name=VI60_defaultClientScript content=VBScript>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<TITLE></TITLE>

<SCRIPT ID=Main Name=Main LANGUAGE=vbscript>
<!--
option Explicit

'// ToolBar's ToolTips
const TT_TLB_INCLUDEVERTICES = "Include Vertices in Tree"
const TT_TLB_SHOWVERTICEX = "Show selected Vertex's location"
const TT_TLB_CLEARVERTICES = "Clear Vertex's Marks"
const TT_TLB_DIGITS_AFTER_DECIMAL = "Digits after decimal point"
const TT_TLB_Help = "Help"
const TT_TLB_TYPE = "Graphic's Type"
const TT_TLB_DELETE = "Delete"
const TT_TLB_CALC = "Calculator"

dim ItemName, ItemID, ItemSubID
ItemName = ""
ItemID = 0
ItemID = 0
Dim sRootName, sVertexName, sAllTypesName

'/////////////////// Specific part //////////////////////////
Sub window_onload

    StBase.ToolName = "Selection Info"
    StBase.ToolVer = "1.01"

    '// Init constants
    sRootName = StTC.ROOT_NAME '// Root
    sVertexName = StTC.VERTEX_NAME '// Vertex
    sAllTypesName	= StTC.ALLTYPES_NAME

    '// Set InitialSize
    StBase.HideAllScriptlets
    StBase.ResizeAllScriplets

    '// Display all Scriptlets Controls
    StBase.ShowAllScriptlets

    '// Specific Controls
    '// Fill ToolBar
    InitToolBar
    StTC.CreateEvents(StTC.EventBeforeExit + StTC.EventSelectionChange + StTC.EventStartNewTool)
    UpdateUI

    window.setTimeout "DoLog", 100
End Sub

Sub window_onresize
    '// Resize all Scriptlets Controls
    StBase.HideAllScriptlets
    StBase.ResizeAllScriplets
    StBase.ShowAllScriptlets
End Sub

Sub window_onhelp
    'StBase.Help
End Sub

'// InitToolBar
'//
sub InitToolBar

    '// Add Images
    With StToolBar.ImgList.ListImages
    .Clear
    .Add  ,"Vertices",	LoadPicture(StBase.ImagePath + "TLB_Vertices.bmp")
    .Add  ,"ShowVertex",LoadPicture(StBase.ImagePath + "TLB_ShowVertex.bmp")
    .Add  ,"ClearMarks",LoadPicture(StBase.ImagePath + "TLB_ClearMarks.bmp")
    .Add  ,"Precision", LoadPicture(StBase.ImagePath + "TLB_Precision.bmp")
    '.Add  ,"Help",		LoadPicture(StBase.ImagePath + "TLB_Help.bmp")
    .Add  ,"Calculator",LoadPicture(StBase.ImagePath + "TLB_Calculator.bmp")
    StToolBar.SetImageList
    End With

    '// Add Buttons
    With StToolBar.ToolBar.Buttons
    .Add (, "Vertices",, StToolBar.tbrCheck, "Vertices").ToolTipText = TT_TLB_INCLUDEVERTICES
    .Add (, "ShowVertex", ,,"ShowVertex"	).ToolTipText = TT_TLB_SHOWVERTICEX
    .Add (, "ClearMarks", ,,"ClearMarks"	).ToolTipText = TT_TLB_CLEARVERTICES
    .Add  ,	, , StToolBar.tbrSeparator
    .Add (, "Precision", , StToolBar.tbrDropDown, "Precision").ToolTipText = TT_TLB_DIGITS_AFTER_DECIMAL
    .Add (, "Calculator",,StToolBar.tbrCheck,"Calculator").ToolTipText = TT_TLB_CALC
    '.Add (, "Help", ,,"Help").ToolTipText = TT_TLB_Help
    .Add  , , , StToolBar.tbrSeparator
     End With
    StToolBar.ToolBar.Buttons("Vertices").value = 1

    '// Fill Precision Menu
    With StToolBar.ToolBar.Buttons("Precision")

    if StTC.objApp.Drawings.count <> 0 then
        .ButtonMenus.Add( ,,"As Drawing").Enabled = 0
        .ButtonMenus.Add ,,"0.00"
        StObjectBase.DigitsAfterDecimal = StTC.objApp.ActiveDrawing.Properties("$LUPREC")
    else
        .ButtonMenus.Add ,,"As Drawing"
        .ButtonMenus.Add( ,,"0.00").Enabled = 0
        StObjectBase.DigitsAfterDecimal = 2
    end if

    .ButtonMenus.Add ,,"0.0000"
    .ButtonMenus.Add ,,"0.000000"
    .ButtonMenus.Add ,,"0.00000000"
    .ButtonMenus.Add ,"Key Max Precision (15)","Max Precision (15)"
     End With

end sub '//InitToolBar

sub UpdateUI

    dim bDrawing, bVertexSelected, bGraphicSelected
    bDrawing = false
    bVertexSelected = false
    bGraphicSelected = false

    bDrawing = (StTC.objApp.Drawings.count <> 0)
    bVertexSelected = (ItemName = sVertexName)
    bGraphicSelected = StObjectBase.IsGraphic(ItemName)

    '// Update ToolBar
    with StToolBar.ToolBar
        .Buttons("Vertices").Enabled	= bDrawing
        .Buttons("ShowVertex").Enabled	= bDrawing and bVertexSelected
        .Buttons("ClearMarks").Enabled	= bDrawing
        .Buttons("Precision").Enabled	= bDrawing
        '.Buttons("Help").Enabled		= true
        .Buttons("Calculator").Enabled	= true
     end with

    '// Update StDrawingTree
     if (not bDrawing) then
         StDrawingTree.ClearContent
         StObjectBase.ClearContent
    end if
end sub

sub DoLog
    if StDrawingTree.DoDwgLog(true, true, StToolBar.ToolBar.Buttons("Vertices").value, sAllTypesName) then
        StDrawingTree.NodeClick
        UpdateUI
    end if
end sub

sub SelectionChangeEvent
    DoLog
    UpdateUI
    StTC.ReleaseEvent(32768) '// 32768 = EventSelectionChange
end sub

-->
</SCRIPT>

<SCRIPT language="vbscript" for=StToolBar event="onscriptletevent(eventname, eventdata)">
'// event From StToolBar
    select case eventname
        case "ButtonClick"
            select case eventdata.Key

                case "Vertices"
                    DoLog
                case "ShowVertex"
                    StDrawingTree.NodeDblClick

                case "ClearMarks"
                    StTC.objApp.ActiveDrawing.Views.Item(0).Refresh

                case "Help"
                    'StBase.Help

                case "Calculator"
                    if StCalculator.IsShowable then
                        StCalculator.Hide(StCalculator)
                    else
                        StCalculator.Show(StCalculator)
                    end if
                    StCalculator.IsShowable = not StCalculator.IsShowable
                    window_onresize

             end select

        case "MenuClick"

            Select Case eventdata.Text
                case "As Drawing"
                    StObjectBase.DigitsAfterDecimal = StTC.objApp.ActiveDrawing.Properties("$LUPREC")
                case "0.00"
                    StObjectBase.DigitsAfterDecimal = 2
                case "0.0000"
                    StObjectBase.DigitsAfterDecimal = 4
                case "0.000000"
                    StObjectBase.DigitsAfterDecimal = 6
                case "0.00000000"
                    StObjectBase.DigitsAfterDecimal = 8
                case "Max Precision (15)"
                    StObjectBase.DigitsAfterDecimal = 15
                end select

                dim item
                for each item in StToolbar.Toolbar.Buttons("Precision").ButtonMenus
                    item.Enabled = 1
                next
                eventdata.Enabled = 0

                StDrawingTree.NodeClick
            end select

    UpdateUI
</SCRIPT>

<SCRIPT language="vbscript" for=StDrawingTree event="onscriptletevent(eventname, Node)">
'// event From StDrawingTree

    '// Check Object
    if not StObjectBase.ObjectExist(StDrawingTree.ItemName(Node), StDrawingTree.ItemID(Node)) then
        dim sMessage, iRes
        sMessage = "Object: " + ItemName + " not found." + vbCrLf
        sMessage = sMessage + "Drawing was changed." + vbCrLf
        sMessage = sMessage + "Do you want to rescan selection?"
        iRes = MsgBox(sMessage, vbYesNo + vbInformation, "Plugin " + PLUGIN_NAME + " Warning")
        if (iRes = vbYes) then
            window.setTimeout "DoLog", 200
        end if
        exit sub
     end if

    ItemName = StDrawingTree.ItemName(Node)
    ItemID = StDrawingTree.ItemID(Node)
    ItemSubID = StDrawingTree.ItemSubID(Node)

    '// Set Statistic for Root
    if ItemName = sRootName then
        ItemID = StDrawingTree.GraphicsCount
        ItemSubID = StDrawingTree.VerticesCount
    end if

    select case eventname

        case "TreeView_Click"
            call StObjectBase.ShowObjectInfo(ItemName, ItemID, ItemSubID)

        case "TreeView_DblClick"
            if ItemName = sVertexName then	call StObjectBase.DisplayObject(ItemName, ItemID, ItemSubID)

        case "TreeView_KeyUp"
            if (StDrawingTree.LastSelNodeIndex <> Node.Index) then
                call StObjectBase.ShowObjectInfo(ItemName, ItemID, ItemSubID)
            end if

    end select

    UpdateUI
</SCRIPT>

<SCRIPT language="vbscript" for=StObjectBase event="onscriptletevent(eventname, eventdata)">
'// event From StObjectBase
    select case eventname

        case "ListView_Click"
            if (StCalculator.IsShowable) then StCalculator.CalculatorVal = eventdata

    end select
    'UpdateUI
</SCRIPT>

<SCRIPT language="vbscript" for=StTC event="onscriptletevent(eventname, eventdata)">
'// event From StTC
    select case eventname
        case "EventSelectionChange", "EventStartNewTool"
            window.setTimeout "SelectionChangeEvent", 100
        case else
            window.setTimeout "UpdateUI", 0
    end select
</SCRIPT>

<SCRIPT language="vbscript" for=StBase event="onscriptletevent(eventname, eventdata)">
'// event From StBase
    select case eventname
        case "ShowAll"
            window.setTimeout "DoLog", 100
            StTC.CreateEvents(StTC.EventBeforeExit + StTC.EventSelectionChange + StTC.EventStartNewTool)
        case "HideAll"
            StTC.DeleteEvents
    end select
    UpdateUI
</SCRIPT>

</HEAD>

<BODY bgColor=#e6e6e6 style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small" scroll=no>

<!-- StBase -->
<OBJECT height=19 id=StBase name=StBase
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 102"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StBase.htm"></OBJECT>

<!-- StToolBar -->
<OBJECT height=24 id=StToolBar name=StToolBar
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 21px; Z-INDEX: 103"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StToolBar.htm"></OBJECT>

<!-- StDrawingTree -->
<OBJECT height=400 id=StDrawingTree name=StDrawingTree
style="BACKGROUND-COLOR: silver; DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 45px; Z-INDEX: 104"
type=text/x-scriptlet width=300><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StDrawingTree.htm"></OBJECT>

<!-- StObjectBase -->
<OBJECT height=190 id=StObjectBase name=StObjectBase
style="BACKGROUND-COLOR: silver; BORDER-BOTTOM-COLOR: white; BORDER-TOP-COLOR: white; DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 330px; Z-INDEX: 104"
type=text/x-scriptlet width=300><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StObjectBase.htm"></OBJECT>

<!-- StCalculator -->
<OBJECT height=180 id=StCalculator name=StCalculator
style="DISPLAY: none; LEFT: 2px; POSITION: absolute; TOP: 515px; Z-INDEX: 104"
type=text/x-scriptlet width=267><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StCalculator.htm"></OBJECT>

<!-- StTC -->
<OBJECT height=0 id=StTC name=StTC
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 300px; Z-INDEX: 104"
type=text/x-scriptlet width=0><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StTC.htm"></OBJECT>

<!------------------ Specific Controls -------------------------->

</BODY>
</HTML>


Examples - Internet Palette Scripts - Scr&&

Scr&&

Internet Palette Scripts Example

<HTML>
<HEAD><TITLE></TITLE>
<META content="text/html; charset=unicode" http-equiv=Content-Type>

<SCRIPT ID=Main Name="Main" LANGUAGE=vbscript>
<!--
option Explicit

'// Prefix Component as: TCWSCRIPT_VSCRIPT_Drawing Clear All
const PREFIX_TCWSCRIPT = "TCWSCRIPT_"
const PREFIX_VBASIC = "VSCRIPT_"
const PREFIX_JAVA	= "JSCRIPT_"

'////////// Plugin Common Part /////////////////////
Sub window_onload
    StBase.ToolName = "Script Lab"
    StBase.ToolVer = "1.01"

    '// Set Initial size
    StBase.ResizeAllScriplets

    '// TODO your code
    InitToolBar
    window.setTimeout "InitCombo", 0

    StTC.CreateEvents(StTC.EventBeforeExit + StTC.EventSelectionChange + StTC.EventStartNewTool)
    UpdateUI

End Sub

Sub window_onresize
    StBase.ResizeAllScriplets' // Resize all Scriptlets Controls
End Sub

Sub window_onhelp
    StBase.Help
End Sub

'// InitToolBar
'//
sub InitToolBar

    '// Add Images
    With StToolBar.ImgList.ListImages
    .Clear
    .Add  ,"Run",			LoadPicture(StBase.ImagePath + "TLB_ScriptRun.bmp")
    .Add  ,"Java",			LoadPicture(StBase.ImagePath + "TLB_ScriptJava.bmp")
    StToolBar.SetImageList
    End With

    '// Add Buttons
    With StToolBar.ToolBar.Buttons
    .Add (, "Run",,,"Run").ToolTipText = "Apply Script (F8)"
    .Add  ,	, , StToolBar.tbrSeparator
    .Add (, "Java",,1,"Java").ToolTipText = "Toggle Java/Basic (Ctrl - J)"
    .Add  ,	, , StToolBar.tbrSeparator
    .Add  ,  "Combo",,StToolBar.tbrPlaceholder

     End With
    StToolBar.ToolBar.Buttons("Combo").Width = 180
    'StToolBar.ToolBar.Buttons("Java").value = 1

end sub '//InitToolBar

sub UpdateUI
    '// Update ToolBar
    with StToolBar.ToolBar
        .Buttons("Run").Enabled	= (StTC.objApp.Drawings.count <> 0)
     end with
end sub

'// InitCombo
'//
sub InitCombo
    With Combo
      .style.Width = StToolBar.ToolBar.Buttons("Combo").Width
      .style.Top = StToolBar.ToolBar.Buttons("Combo").Top + StBase.PixToI(StToolBar.style.top) + 1
      .style.Left = StToolBar.ToolBar.Buttons("Combo").Left
      .style.fontSize = 12
     End With
     UpdateCombo
end sub '//InitCombo

'// UpdateCombo
'//
sub UpdateCombo

    dim i
    for i = 1 to Combo.options.length
        Combo.options.remove(0)
    next

    dim bJava
    bJava = CBool(StToolBar.ToolBar.Buttons("Java").value)

    dim ItemPre ,Item, sPrefix
    for i = 0 to document.all.length - 1
        if (document.all.item(i).tagName = "SCRIPT") then'// Check Tag "SCRIPT"
            sPrefix = document.all.item(i).ID
            if (IsPrefixScrptLab(sPrefix) and bJava = IsPrefixJava(sPrefix)) then '// Check Tag ID
                set item = document.createElement("Option")
                item.text = PrefixGetScriptName(sPrefix)
                item.value = item.text
                Combo.add(item)
                set item = nothing
            end if
        end if
    next

    '// Get Script from Combo
    StText.value = document.all(GetScrptLabPrefix + Combo.value).text
    window.status = Combo.value
end sub '//UpdateCombo

function GetCustomScript
    GetCustomScript = document.scripts("TCWScript").text
end function

sub SetCustomScript(str, bJava)
    document.scripts("TCWScriptJava").text = ""
    document.scripts("TCWScriptBasic").text = ""

    if (bJava = 1) then
        document.scripts("TCWScriptJava").text = str
    else
        document.scripts("TCWScriptBasic").text = str
    end if
end sub

dim bJava, ActiveDrawing

Sub RunScript
    dim i
    bJava = CBool(StToolBar.ToolBar.Buttons("Java").value)
    Set ActiveDrawing = StTC.ActiveDrawing

    '// Init
    On Error Resume Next
    Err.Clear

    if (bJava) then
        call MainJava()
    else
        call MainBasic()
    end if

    if Err.Number > 0 then
     MsgBox "Error # " & CStr(Err.Number) & " " & Err.Description
        Err.Clear
    end if

    Set ActiveDrawing = Nothing

    'Execute(StText.value)
End Sub '//RunScript

sub StTCEvent
    UpdateUI
    StTC.ReleaseEvent(StTC.EventsFlag) '// Release All Events
end sub

function GetScrptLabPrefix
    GetScrptLabPrefix = PREFIX_TCWSCRIPT

    if (StToolBar.ToolBar.Buttons("Java").value) then
        GetScrptLabPrefix = GetScrptLabPrefix + PREFIX_JAVA
    else
        GetScrptLabPrefix = GetScrptLabPrefix + PREFIX_VBASIC
    end if

end function

function IsPrefixScrptLab(sTCWScriptName)
    if InStr(1 ,sTCWScriptName, PREFIX_TCWSCRIPT, 1) = 1 then
        IsPrefixScrptLab = TRUE
    else
        IsPrefixScrptLab = FALSE
    end if
end function

function IsPrefixJava(sTCWScriptName)

    if (InStr(1, sTCWScriptName, PREFIX_TCWSCRIPT + PREFIX_JAVA, 1) = 1)then
        IsPrefixJava = TRUE
    else
        IsPrefixJava = FALSE
    end if
end function

function PrefixGetScriptName(sTCWScriptName)
    PrefixGetScriptName = Right(sTCWScriptName, len(sTCWScriptName) - len(PREFIX_TCWSCRIPT + PREFIX_VBASIC))
end function

'// Accelerators routine
'//		F8			Apply Script
'//		Ctrl - J	Toggle Java/Basic
'//		Alt	 - C	Acces Key for ComboBox
Sub StText_onkeydown
    TranslateAccelerators(StText.event)
End Sub

Sub Document_onkeydown
    TranslateAccelerators(window.event)
End Sub

sub TranslateAccelerators(e)
    if e.ctrlKey then
        select case Chr(e.KeyCode)
            case "J"
                if StToolBar.ToolBar.Buttons("Java").Enabled then
                    StToolBar.ToolBar.Buttons("Java").Value = StToolBar.ToolBar.Buttons("Java").Value xor 1
                    UpdateCombo
                end if
        end select
    else
        select case e.KeyCode
            case 119 '// 119 = F8
                if StToolBar.ToolBar.Buttons("Run").Enabled then
                    call SetCustomScript(StText.value, StToolBar.ToolBar.Buttons("Java").value)
                    RunScript
                end if
        end select
    end if
end sub

-->
</SCRIPT>

<!-- event From StBase -->
<SCRIPT language="vbscript" for=StBase event="onscriptletevent(eventname, eventdata)">
    select case eventname

        '// Start
        case "ShowAll"
            Combo.style.display = ""

        '// Stop
        case "HideAll"
            Combo.style.display = "none"
            StTC.DeleteEvents

    end select

</SCRIPT>

<SCRIPT language="vbscript" for=StToolBar event="onscriptletevent(eventname, eventdata)">
'// event From StToolBar
    select case eventname
        case "ButtonClick"
            select case eventdata.Key
                case "Run"
                    'Set ActiveDrawing = StTC.ActiveDrawing
                    'MainJava1
                    'Set ActiveDrawing = Nothing
                    call SetCustomScript(StText.value, StToolBar.ToolBar.Buttons("Java").value)
                    RunScript
                case "Java"
                    UpdateCombo
            end select
    end select
</SCRIPT>

<SCRIPT language="vbscript" for=StTC event="onscriptletevent(eventname, eventdata)">
'// event From StTC
    window.setTimeout "StTCEvent", 0
</SCRIPT>

<SCRIPT ID=clientEventHandlersVBS LANGUAGE=vbscript>
<!--
Sub Combo_onchange
    dim s
    s = GetScrptLabPrefix + Combo.value
    StText.value = document.all(s).text
    window.status = Combo.value
End Sub
-->
</SCRIPT>

<SCRIPT ID=TCWScriptBasic LANGUAGE=vbscript>
</SCRIPT>

<SCRIPT ID=TCWScriptJava LANGUAGE=JScript
>function MainJava1()
{
  var Views;
  var View1;

  ActiveDrawing.Graphics.Select();
  Views = ActiveDrawing.Views;
  View1 = Views.Item(0);

  alert("Refresh Start");
  View1.Refresh();
  alert("Refresh Finish");
}
</SCRIPT>

</HEAD>

<BODY bgcolor=#e6e6e6 style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small" scroll=no>

<SCRIPT LANGUAGE=vbscript ID="TCWSCRIPT_VSCRIPT_Drawing Select All" style="display=none"
>Sub MainBasic
  ActiveDrawing.Graphics.Select
  ActiveDrawing.Views.Item(0).Refresh
end sub
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="TCWSCRIPT_VSCRIPT_Drawing UnSelect All" style="display=none"
>Sub MainBasic
  ActiveDrawing.Graphics.UnSelect
  ActiveDrawing.Views.Item(0).Refresh
end sub
</SCRIPT>

<SCRIPT LANGUAGE=vbscript ID="TCWSCRIPT_VSCRIPT_Drawing GraphicsCount" style="display=none"
>Sub MainBasic
  Alert ActiveDrawing.Graphics.Count
end sub
</SCRIPT>

<SCRIPT LANGUAGE=JScript ID="TCWSCRIPT_JSCRIPT_Drawing Select All" style="display=none"
>function MainJava()
{
  var Views;
  var View;

  ActiveDrawing.Graphics.Select();
  Views = ActiveDrawing.Views;
  View = Views.Item(0);

  alert("Refresh Start");
  View.Refresh();
  alert("Refresh Finish");
}
</SCRIPT>

<SCRIPT LANGUAGE=JScript ID="TCWSCRIPT_JSCRIPT_Drawing GraphicsCount" style="display=none"
>function MainJava()
{
  alert(ActiveDrawing.Graphics.Count);
}
</SCRIPT>

<!-- StBase: Plugin base module (Header, Stop, Star, About, resize ...)-->
<OBJECT height=19 id=StBase name=StBase
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 102"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StBase.htm"></OBJECT>

<!-- StTC -->
<OBJECT height=0 id=StTC name=StTC
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 104"
type=text/x-scriptlet width=0><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StTC.htm"></OBJECT>

<!-- StToolBar -->
<OBJECT height=24 id=StToolBar name=StToolBar
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 21px; Z-INDEX: 103"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StToolBar.htm"></OBJECT>

<!-- StText -->
<OBJECT height=300 id=StText name=StText
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 45px; Z-INDEX: 103"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StText.htm"></OBJECT>

<!------------------ Specific Controls -------------------------->
<SELECT id=Combo name=Combo
    style="FONT-FAMILY:
     sans-serif; FONT-SIZE: xx-small;
     LEFT: 0px;
     POSITION: absolute;
     TOP: 0px;
     WIDTH: 0px;
     Z-INDEX: 105;
    multiple;: 105"
    accesskey=c  >
</SELECT>

</BODY>
</HTML>


Examples - Internet Palette Scripts - SDK Sample Calculator.htm

SDK Sample Calculator.htm

Internet Palette Scripts Example

<HTML>
<HEAD><TITLE></TITLE>
<META content="text/html; charset=unicode" http-equiv=Content-Type>

<SCRIPT ID=Main Name="Main" LANGUAGE=vbscript>
<!--
option Explicit

'////////// Plugin Common Part /////////////////////
Sub window_onload
    StBase.ToolName = "Calculator"
    StBase.ToolVer = "1.01"

    StCalculator.IsShowable = TRUE

    '// Set Initial size
    StBase.ResizeAllScriplets
End Sub

Sub window_onresize
    StBase.ResizeAllScriplets' // Resize all Scriptlets Controls
End Sub

Sub window_onhelp
    StBase.Help
End Sub

-->
</SCRIPT>

<!-- event From StBase -->
<SCRIPT language="vbscript" for=StBase event="onscriptletevent(eventname, eventdata)">
    select case eventname

        '// Start
        case "ShowAll"
        '// TODO Show All spwcific controls

        '// Stop
        case "HideAll"
        '// TODO Hide All spwcific controls

    end select
</SCRIPT>

</HEAD>
<BODY bgcolor=#e6e6e6 style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small" scroll=no>

<!-- StBase: plugin base module (Header, Stop, Star, About, resize ...)-->
<OBJECT height=19 id=StBase name=StBase
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 102"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StBase.htm"></OBJECT>

<!-- StCalculator -->
<OBJECT height=180 id=StCalculator name=StCalculator
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 19px; Z-INDEX: 104"
type=text/x-scriptlet width=267><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StCalculator.htm"></OBJECT>

</BODY>
</HTML>


Examples - Internet Palette Scripts - SDK Sample DrawingTree.htm

SDK Sample DrawingTree.htm

Internet Palette Scripts Example

<HTML>
<HEAD><TITLE></TITLE>
<META content="text/html; charset=unicode" http-equiv=Content-Type>

<SCRIPT ID=Main Name="Main" LANGUAGE=vbscript>
<!--
option Explicit

'////////// Plugin Common Part /////////////////////
Sub window_onload
    StBase.ToolName = "Sample Drawing Tree"
    StBase.ToolVer = "1.01"

    '// Set Initial size
    StBase.ResizeAllScriplets

    '// TODO your code

    'call StTC.ObjApp.Drawings(0).SaveAs("d:\1.tcw")

    StDrawingTree.DoDwgLog false, true, true, StTC.ALLTYPES_NAME
End Sub

Sub window_onresize
    StBase.ResizeAllScriplets' // Resize all Scriptlets Controls
End Sub

Sub window_onhelp
    StBase.Help
End Sub

-->
</SCRIPT>

<!-- event From StBase -->
<SCRIPT language="vbscript" for=StBase event="onscriptletevent(eventname, eventdata)">
    select case eventname

        '// Start
        case "ShowAll"
        '// TODO Show All spwcific controls

        '// Stop
        case "HideAll"
        '// TODO Hide All spwcific controls

    end select
</SCRIPT>

</HEAD>
<BODY bgcolor=#e6e6e6 style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small" scroll=no>

<!-- StBase: plugin base module (Header, Stop, Star, About, resize ...)-->
<OBJECT height=19 id=StBase name=StBase
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 102"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StBase.htm"></OBJECT>

<!-- StTC: TurboCad application base module -->
<OBJECT height=0 id=StTC name=StTC
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 300px; Z-INDEX: 104"
type=text/x-scriptlet width=0><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StTC.htm"></OBJECT>

<!-- StDrawingTree -->
<OBJECT height=400 id=StDrawingTree name=StDrawingTree
style="BACKGROUND-COLOR: silver; DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 45px; Z-INDEX: 104"
type=text/x-scriptlet width=300><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StDrawingTree.htm"></OBJECT>

</BODY>
</HTML>


Examples - Internet Palette Scripts - SDK Sample ID Keeper.htm

SDK Sample ID Keeper.htm

Internet Palette Scripts Example

<HTML>
<HEAD><TITLE></TITLE>
<META content="text/html; charset=unicode" http-equiv=Content-Type>

<SCRIPT ID=Main Name="Main" LANGUAGE=vbscript>
<!--
option Explicit

'////////// Plugin Common Part /////////////////////
Sub window_onload
    StBase.ToolName = "ID Keeper"
    StBase.ToolVer = "1.01"

    '// Set Initial size
    StBase.ResizeAllScriplets

    '// TODO you code
    InitSpecificObjects
End Sub

Sub window_onresize
    StBase.ResizeAllScriplets' // Resize all Scriptlets Controls
End Sub

Sub window_onhelp
    StBase.Help
End Sub

'////////////////////////////////////////////////////
Const Max_ID = 70000000 '// 70 000 000

'// Specific LayOut Constants
Dim MaxID
Dim bRecurcive

'// Timer routine
Dim bSetTimer, TimeDelay
bSetTimer = TRUE
TimeDelay = 1 '// sec

Dim bSelectionOnly
bSelectionOnly = FALSE

Dim bchkBlocks
bchkBlocks = FALSE

Dim OldMaxID
OldMaxID =  - 1.0

Dim bWarnWasShow
bWarnWasShow = FALSE

bRecurcive = FALSE

'// InitSpecificObjects
'//
sub InitSpecificObjects
    if bSetTimer then
        window.setTimeout "btnUpdate_onclick", TimeDelay * 1000
    end if
end sub '// InitSpecificObjects

'// InitToolUI
sub InitToolUI
    '// Specific part
    if chkTimer.checked then
        bSetTimer = TRUE
    else
        bSetTimer = FALSE
    end if

    if chkDeep.checked then
        bRecurcive = TRUE
    else
        bRecurcive = FALSE
    end if

end sub'// InitToolUI

Sub GetMaxID(Grs)
    Dim Gr, GrsCount, GrID
    GrsCount = Grs.Count

    if GrsCount > 0 then

        For Each Gr in Grs

            if bRecurcive then
                GetMaxID Gr.Graphics
            end if

            GrID = Gr.ID

            if MaxID < GrID then
                MaxID = GrID
            end if

        Next
    end if
end sub

Dim bYetRun
bYetRun = FALSE

Sub btnUpdate_onclick

    if bYetRun then
        if bSetTimer then
            window.setTimeout "btnUpdate_onclick", TimeDelay * 1000
        end if
        Exit Sub
    end if

    bYetRun = TRUE

    Dim Gr, Grs, GrID, GrsCount, i
    MaxID = 0.0

    if StTC.objApp.Drawings.Count > 0 then

        if bSelectionOnly then
            Set Grs = stTC.SelectGraphicsCollection
        else
            Set Grs = stTC.GraphicsCollection
        end if

        GrsCount = Grs.Count

        if GrsCount > 0 then
            i = 0

            GetMaxID Grs

            set Grs = Nothing

        end if

        if bchkBlocks and not bSelectionOnly then
            Dim Blocks, Block, BlocksCount, NodeBlock, ActDrawing
            Set ActDrawing = StTC.ActiveDrawing
            Set Blocks = ActDrawing.Blocks
            BlocksCount = Blocks.Count
            if (BlocksCount > 0) then
            For i = 0 To (BlocksCount - 1)
                Set Block = Blocks.Item(i)

                GetMaxID Block.Graphics

                Set Block = Nothing
                Next
            end if
            Set Blocks = Nothing
            Set ActDrawing = Nothing
        end if

    end if

    if MaxID > Max_ID then
        if not bWarnWasShow then
            Alert "Your drawing Object ID is above critical value." + vbCrLf + _
                  "It is recommended to Save the drawing, Close and then Open it."
            bWarnWasShow = TRUE
        end if
     else
        bWarnWasShow = FALSE
    end if

    if OldMaxID <> MaxID then
        OldMaxID = MaxID

        if MaxID < MAX_ID then
            LabelMAXID.style.color = 255*CLng(MaxID/MAX_ID) * &H10000
            'LabelMAXID.style.color = 190 * &H10000
        else
            LabelMAXID.style.color = 255*&H10000 '//Red
        end if

        LabelMAXID.innerText = "Max ID = " + CStr(MaxID)
    end if

    bYetRun = FALSE

    if bSetTimer then
        window.setTimeout "btnUpdate_onclick", TimeDelay * 1000
    end if
End Sub

Sub chkTimer_onclick
    if chkTimer.checked then
        bSetTimer = TRUE
        btnUpdate_onclick
    else
        bSetTimer = FALSE
    end if
End Sub

Sub chkDeep_onclick

    if chkDeep.checked then
        bRecurcive = TRUE
        btnUpdate_onclick
    else
        bRecurcive = FALSE
        btnUpdate_onclick
    end if

End Sub

Sub select1_onchange
    TimeDelay = select1.item(select1.selectedIndex).value
    btnUpdate_onclick
End Sub

Sub chkSelection_onclick
    if chkSelection.checked then
        bSelectionOnly = TRUE
        btnUpdate_onclick
    else
        bSelectionOnly = FALSE
    end if
End Sub

Sub chkBlocks_onclick
    if chkBlocks.checked then
        bchkBlocks = TRUE
        btnUpdate_onclick
    else
        bchkBlocks = FALSE
    end if
End Sub

-->
</SCRIPT>

<!-- event From StBase -->
<SCRIPT language="vbscript" for=StBase event="onscriptletevent(eventname, eventdata)">
    select case eventname

        '// Start
        case "ShowAll"
        '// TODO Show All spwcific controls
        btnUpdate.style.display = ""
        LabelMAXID.style.display = ""
        chkDeep.style.display = ""
        chkTimer.style.display = ""
        chkBlocks.style.display = ""
        pchkDeep.style.display = ""
        pchkTimer.style.display = ""
        pchkSelection.style.display = ""
        TextBlocks.style.display = ""

        '// Stop
        case "HideAll"
        '// TODO Hide All spwcific controls
        btnUpdate.style.display = "none"
        LabelMAXID.style.display = "none"
        chkDeep.style.display = "none"
        chkTimer.style.display = "none"

        pchkDeep.style.display = "none"
        pchkTimer.style.display = "none"
        pchkSelection.style.display = "none"
        chkBlocks.style.display = "none"
        TextBlocks.style.display = "none"

    end select
</SCRIPT>

</HEAD>
<BODY bgcolor=#e6e6e6 style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small" scroll=no>

<!-- StBase: plugin base module (Header, Stop, Star, About, resize ...)-->
<OBJECT height=19 id=StBase name=StBase
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 102"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StBase.htm"></OBJECT>

<!-- StTC: TurboCad application base module -->
<OBJECT height=0 id=StTC name=StTC
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 300px; Z-INDEX: 104"
type=text/x-scriptlet width=0><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StTC.htm"></OBJECT>

<!------------------ Specific part -------------------------->

<P > &nbsp;</P>
<P align=left id=LabelMAXID style="BACKGROUND-REPEAT: no-repeat; COLOR: black; FONT-FAMILY: sans-serif; FONT-SIZE: medium; FONT-STYLE: normal; FONT-WEIGHT: normal; HEIGHT: 34px; LEFT: 5px; POSITION: absolute; TEXT-DECORATION: none; VERTICAL-ALIGN: middle; WIDTH: 257px">Max ID = </P>
<P > &nbsp;</P>

<P id=pchkTimer style="FONT-SIZE: x-small">
<INPUT id=chkTimer name=chkTimer type=checkbox CHECKED>&nbsp;Check every&nbsp;
<SELECT id=select1 name=select1 style="FONT-SIZE: x-small; HEIGHT: 21px; WIDTH: 58px">
  <OPTION selected value=1 >1</OPTION>
  <OPTION value=10>10</OPTION>
  <OPTION value=20>20</OPTION>
  <OPTION value=30>30</OPTION>
  <OPTION value=40>40</OPTION>
  <OPTION value=50>50</OPTION>
  <OPTION value=60>60</OPTION>  </SELECT> &nbsp;sec</P>

<P id=pchkDeep style="BORDER-BOTTOM-COLOR: silver; FONT-SIZE: x-small; FONT-WEIGHT: normal; TEXT-ALIGN: left">
<INPUT id=chkDeep name=chkDeep type=checkbox>Deep</P>

<P id=pchkSelection style="BORDER-BOTTOM-COLOR: silver; FONT-SIZE: x-small; FONT-WEIGHT: normal; TEXT-ALIGN: left">
<INPUT id=chkSelection name=chkSelection type=checkbox>Selection Only</P>

<P ID=TextBlocks style="BORDER-BOTTOM-COLOR: silver; FONT-SIZE: x-small; FONT-WEIGHT: normal; TEXT-ALIGN: left">
<INPUT id=chkBlocks name=chkBlocks type=checkbox>Blocks</P>

<P style="BORDER-BOTTOM-COLOR: silver; FONT-SIZE: x-small; FONT-WEIGHT: normal; TEXT-ALIGN: left"></P>

<INPUT id=btnUpdate name=btnUpdate style="BACKGROUND-COLOR: lightgoldenrodyellow;
     BORDER-BOTTOM-COLOR:
    silver; BORDER-LEFT-COLOR:
    white; FONT-FAMILY:
    monospace; FONT-SIZE:
    x-small; FONT-STYLE: normal; HEIGHT: 29px; LEFT:
    10px; POSITION: absolute; TEXT-TRANSFORM: none; TOP: 296px;
     WIDTH: 108px; Z-INDEX: 102" type=button border=0 align=right hspace=0 value="Check ID">

</BODY>
</HTML>


Examples - Internet Palette Scripts - SDK Sample ShowFirstGraphic.htm

SDK Sample ShowFirstGraphic.htm

Internet Palette Scripts Example

<HTML>
<HEAD><TITLE></TITLE>
<META content="text/html; charset=unicode" http-equiv=Content-Type>

<SCRIPT ID=Main Name="Main" LANGUAGE=vbscript>
<!--
option Explicit

'////////// Plugin Common Part /////////////////////
Sub window_onload
    StBase.ToolName = "Sample: Show First Graphic"
    StBase.ToolVer = "1.01"

    StObjectBase.CanChangeHeight = TRUE

    '// Set Initial size
    StBase.ResizeAllScriplets

    '// TODO your code
    'StTC.ObjApp.ActiveDrawing.Graphics(0)
    dim GrID
    GrID = StTC.ObjApp.ActiveDrawing.Graphics.Item(0).ID
    StObjectBase.ShowGraphicInfo(GrID)
End Sub

Sub window_onresize
    StBase.ResizeAllScriplets' // Resize all Scriptlets Controls
End Sub

Sub window_onhelp
    StBase.Help
End Sub

-->
</SCRIPT>

<!-- event From StBase -->
<SCRIPT language="vbscript" for=StBase event="onscriptletevent(eventname, eventdata)">
    select case eventname

        '// Start
        case "ShowAll"
        '// TODO Show All spwcific controls

        '// Stop
        case "HideAll"
        '// TODO Hide All spwcific controls

    end select
</SCRIPT>

</HEAD>
<BODY bgcolor=#e6e6e6 style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small" scroll=no>

<!-- StBase: plugin base module (Header, Stop, Star, About, resize ...)-->
<OBJECT height=19 id=StBase name=StBase
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 102"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StBase.htm"></OBJECT>

<!-- StTC: TurboCad application base module -->
<OBJECT height=0 id=StTC name=StTC
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 300px; Z-INDEX: 104"
type=text/x-scriptlet width=0><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StTC.htm"></OBJECT>

<!-- StObjectBase -->
<OBJECT height=190 id=StObjectBase name=StObjectBase
style="BACKGROUND-COLOR: silver; BORDER-BOTTOM-COLOR: white; BORDER-TOP-COLOR: white; DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 45px; Z-INDEX: 104"
type=text/x-scriptlet width=300><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StObjectBase.htm"></OBJECT>

</BODY>
</HTML>


Examples - Internet Palette Scripts - SDK Sample ShowUCS.htm

SDK Sample ShowUCS.htm

Internet Palette Scripts Example

<HTML>
<HEAD><TITLE></TITLE>
<META content="text/html; charset=unicode" http-equiv=Content-Type>

<SCRIPT ID=Main Name="Main" LANGUAGE=vbscript>
<!--
option Explicit

'////////// Plugin Common Part /////////////////////
Sub window_onload
    StBase.ToolName = "Sample: Show UCS"
    StBase.ToolVer = "1.01"

    StObjectBase.CanChangeHeight = TRUE

    '// Set Initial size
    StBase.ResizeAllScriplets

    '// TODO your code
    'StTC.ObjApp.ActiveDrawing.Graphics(0)
    StObjectBase.ShowUCSInfo
End Sub

Sub window_onresize
    StBase.ResizeAllScriplets' // Resize all Scriptlets Controls
End Sub

Sub window_onhelp
    StBase.Help
End Sub

-->
</SCRIPT>

<!-- event From StBase -->
<SCRIPT language="vbscript" for=StBase event="onscriptletevent(eventname, eventdata)">
    select case eventname

        '// Start
        case "ShowAll"
        '// TODO Show All spwcific controls

        '// Stop
        case "HideAll"
        '// TODO Hide All spwcific controls

    end select
</SCRIPT>

</HEAD>
<BODY bgcolor=#e6e6e6 style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small" scroll=no>

<!-- StBase: plugin base module (Header, Stop, Star, About, resize ...)-->
<OBJECT height=19 id=StBase name=StBase
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 102"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StBase.htm"></OBJECT>

<!-- StTC: TurboCad application base module -->
<OBJECT height=0 id=StTC name=StTC
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 300px; Z-INDEX: 104"
type=text/x-scriptlet width=0><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StTC.htm"></OBJECT>

<!-- StObjectBase -->
<OBJECT height=190 id=StObjectBase name=StObjectBase
style="BACKGROUND-COLOR: silver; BORDER-BOTTOM-COLOR: white; BORDER-TOP-COLOR: white; DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 45px; Z-INDEX: 104"
type=text/x-scriptlet width=300><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StObjectBase.htm"></OBJECT>

</BODY>
</HTML>


Examples - Internet Palette Scripts - SDK Sample TC Ver.htm

SDK Sample TC Ver.htm

Internet Palette Scripts Example

<HTML>
<HEAD><TITLE></TITLE>
<META content="text/html; charset=unicode" http-equiv=Content-Type>

<SCRIPT ID=Main Name="Main" LANGUAGE=vbscript>
<!--
option Explicit

'////////// Plugin Common Part /////////////////////
Sub window_onload
    StBase.ToolName = "Sample TC Version"
    StBase.ToolVer = "1.01"

    '// Set Initial size
    StBase.ResizeAllScriplets

    '// TODO your code
    '// Text sample
    mrq1.innerText = "   TCW v" + StTC.ObjApp.Version(0) +  ".   "+ mrq1.innerText

End Sub

Sub window_onresize
    StBase.ResizeAllScriplets' // Resize all Scriptlets Controls
End Sub

Sub window_onhelp
    StBase.Help
End Sub

-->
</SCRIPT>

<!-- event From StBase -->
<SCRIPT language="vbscript" for=StBase event="onscriptletevent(eventname, eventdata)">
    select case eventname

        '// Start
        case "ShowAll"
            '// TODO Show All spwcific controls
            mrq1.style.display = ""
        '// Stop
        case "HideAll"
            '// TODO Hide All spwcific controls
            mrq1.style.display = "none"

    end select
</SCRIPT>

</HEAD>
<BODY bgcolor=#e6e6e6 style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small" scroll=no>

<!-- StBase: plugin base module (Header, Stop, Star, About, resize ...)-->
<OBJECT height=19 id=StBase name=StBase
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 102"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StBase.htm"></OBJECT>

<!-- StTC: TurboCad application base module -->
<OBJECT height=0 id=StTC name=StTC
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 300px; Z-INDEX: 104"
type=text/x-scriptlet width=0><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StTC.htm"></OBJECT>

<FONT COLOR="red">
<MARQUEE ID="mrq1" style="LEFT: 5px; POSITION: absolute; TOP: 33px; Z-INDEX: 105">Plugins are fun and easy!</MARQUEE>
</FONT>

</BODY>
</HTML>


Examples - Internet Palette Scripts - SDK Sample Template.htm

SDK Sample Template.htm

Internet Palette Scripts Example

<HTML>
<HEAD><TITLE></TITLE>
<META content="text/html; charset=unicode" http-equiv=Content-Type>

<SCRIPT ID=Main Name="Main" LANGUAGE=vbscript>
<!--
option Explicit

'////////// Plugin Common Part /////////////////////
Sub window_onload
    StBase.ToolName = "Template"
    StBase.ToolVer = "1.01"

    '// Set Initial size
    StBase.ResizeAllScriplets

    '// TODO your code
End Sub

Sub window_onresize
    StBase.ResizeAllScriplets' // Resize all Scriptlets Controls
End Sub

Sub window_onhelp
    StBase.Help
End Sub

-->
</SCRIPT>

<!-- event From StBase -->
<SCRIPT language="vbscript" for=StBase event="onscriptletevent(eventname, eventdata)">
    select case eventname

        '// Start
        case "ShowAll"
        '// TODO Show All spwcific controls

        '// Stop
        case "HideAll"
        '// TODO Hide All spwcific controls

    end select
</SCRIPT>

</HEAD>
<BODY bgcolor=#e6e6e6 style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small" scroll=no>

<!-- StBase: plugin base module (Header, Stop, Star, About, resize ...)-->
<OBJECT height=19 id=StBase name=StBase
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 102"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StBase.htm"></OBJECT>

<!-- StTC: TurboCad application base module -->
<OBJECT height=0 id=StTC name=StTC
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 300px; Z-INDEX: 104"
type=text/x-scriptlet width=0><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StTC.htm"></OBJECT>

</BODY>
</HTML>


Examples - Internet Palette Scripts - SDK Sample ToolBar.htm

SDK Sample ToolBar.htm

Internet Palette Scripts Example

<HTML>
<HEAD><TITLE></TITLE>
<META content="text/html; charset=unicode" http-equiv=Content-Type>

<SCRIPT ID=Main Name="Main" LANGUAGE=vbscript>
<!--
option Explicit

'// ToolBar's ToolTips
const TT_TLB_LOG = "Logged Drawing"
const TT_TLB_INCLUDEVERTICES = "Include Vertices in Tree"
const TT_TLB_SHOWVERTICEX = "Show selected Vertex's location"
const TT_TLB_CLEARVERTICES = "Clear Vertex's Marks"
const TT_TLB_DIGITS_AFTER_DECIMAL = "Digits after decimal point"
const TT_TLB_Help = "Help"
const TT_TLB_TYPE = "Graphic's Type"
const TT_TLB_DELETE = "Delete"
const TT_TLB_CALC = "Calculator"

'////////// Plugin Common Part /////////////////////
Sub window_onload
    StBase.ToolName = "Sample ToolBar"
    StBase.ToolVer = "1.01"

    '// Set Initial size
    StBase.ResizeAllScriplets

    '// TODO your code
    InitToolBar
End Sub

Sub window_onresize
    StBase.ResizeAllScriplets' // Resize all Scriptlets Controls
End Sub

Sub window_onhelp
    StBase.Help
End Sub

'// InitToolBar
'//
sub InitToolBar

    '// Add Images
    With StToolBar.ImgList.ListImages
    .Clear
    .Add  ,"Log",		LoadPicture(StBase.ImagePath + "TLB_Log.bmp")
    .Add  ,"Vertices",	LoadPicture(StBase.ImagePath + "TLB_Vertices.bmp")
    .Add  ,"ShowVertex",LoadPicture(StBase.ImagePath + "TLB_ShowVertex.bmp")
    .Add  ,"ClearMarks",LoadPicture(StBase.ImagePath + "TLB_ClearMarks.bmp")
    .Add  ,"Precision", LoadPicture(StBase.ImagePath + "TLB_Precision.bmp")
    .Add  ,"Delete",	LoadPicture(StBase.ImagePath + "TLB_Delete.bmp")
    .Add  ,"Help",		LoadPicture(StBase.ImagePath + "TLB_Help.bmp")
    .Add  ,"Calculator",LoadPicture(StBase.ImagePath + "TLB_Calculator.bmp")
    StToolBar.SetImageList
    End With

    '// Add Buttons
    With StToolBar.ToolBar.Buttons
    .Add (, "Log",,,"Log").ToolTipText = TT_TLB_LOG
    .Add (, "Vertices",, StToolBar.tbrCheck, "Vertices").ToolTipText = TT_TLB_INCLUDEVERTICES
    .Add (, "ShowVertex", ,,"ShowVertex"	).ToolTipText = TT_TLB_SHOWVERTICEX
    .Add (, "ClearMarks", ,,"ClearMarks"	).ToolTipText = TT_TLB_CLEARVERTICES
    .Add  ,	, , StToolBar.tbrSeparator
    .Add (, "Precision", , StToolBar.tbrDropDown, "Precision").ToolTipText = TT_TLB_DIGITS_AFTER_DECIMAL
    .Add (, "Calculator",,StToolBar.tbrCheck,"Calculator").ToolTipText = TT_TLB_CALC
    .Add (, "Delete",,, "Delete"	).ToolTipText = TT_TLB_DELETE
    .Add (, "Help", ,,"Help").ToolTipText = TT_TLB_Help
    .Add  , , , StToolBar.tbrSeparator
     End With
    StToolBar.ToolBar.Buttons("Vertices").value = 1

    '// Fill Precision Menu
    With StToolBar.ToolBar.Buttons("Precision")

    .ButtonMenus.Add( ,,"As Drawing").Enabled = 0
    .ButtonMenus.Add ,,"0.00"
    .ButtonMenus.Add ,,"0.0000"
    .ButtonMenus.Add ,,"0.000000"
    .ButtonMenus.Add ,,"0.00000000"
    .ButtonMenus.Add ,"Key Max Precision (15)","Max Precision (15)"
     End With

end sub '//InitToolBar
-->
</SCRIPT>

<!-- event From StBase -->
<SCRIPT language="vbscript" for=StBase event="onscriptletevent(eventname, eventdata)">
    select case eventname

        '// Start
        case "ShowAll"
            '// TODO Show All spwcific controls

        '// Stop
        case "HideAll"
            '// TODO Hide All spwcific controls

    end select
</SCRIPT>

<SCRIPT language="vbscript" for=StToolBar event="onscriptletevent(eventname, eventdata)">
'// event From StToolBar
    select case eventname
        case "ButtonClick"
            Alert eventdata.Key
        case "MenuClick"
            Alert eventdata.Text
    end select
</SCRIPT>

</HEAD>
<BODY bgcolor=#e6e6e6 style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small" scroll=no>

<!-- StBase: plugin base module (Header, Stop, Star, About, resize ...)-->
<OBJECT height=19 id=StBase name=StBase
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 102"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StBase.htm"></OBJECT>

<!-- StToolBar -->
<OBJECT height=24 id=StToolBar name=StToolBar
style="DISPLAY: none; LEFT: 0px; POSITION: absolute; TOP: 21px; Z-INDEX: 103"
type=text/x-scriptlet width=3000><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="CommonScripts\StToolBar.htm"></OBJECT>

</BODY>
</HTML>


Examples - Internet Palette Scripts - StBase.htm

StBase.htm

Internet Palette Scripts Example

<HTML>
<HEAD>
<META name=VI60_defaultClientScript content=VBScript>
<TITLE>StBase</TITLE>

<SCRIPT ID=BaseScript Name=BaseScript LANGUAGE="VBScript">
option Explicit

'// About
Const StName = "StBase"
Const StVer = 1.0

'// resize Behavior vars
dim bCanChangeWidth, bCanChangeHeight, bIsOverPos, bIsShowable
bCanChangeWidth = TRUE
bCanChangeHeight = FALSE
bIsOverPos = FALSE
bIsShowable = TRUE

const nMinHeight = 0
const nMinWidth  = 0
dim nHeight, nWidth
nHeight = 0
nWidth = 0

dim public_description
set public_description = new Interface
class Interface
'/////////// Common functions //////////

    '// TCPlugin
    '// For Scriptlet check
    function TCPlugin
        TCPlugin = TRUE
    end function

    function GetName
        GetName = StName
    end function

    function GetVer
        GetVer = StVer
    end function

    function Get_CanChangeWidth
        Get_CanChangeWidth = bCanChangeWidth
    end function

    function Get_CanChangeHeight
        Get_CanChangeHeight = bCanChangeHeight
    end function

    function Get_IsOverPos
        Get_IsOverPos = bIsOverPos
    end function

    function Get_IsShowable
        Get_IsShowable = bIsShowable
    end function

    '// Min Heght
    function Get_MinHeight
        Get_MinHeight = nMinHeight
    end function

    '// Min Width
    function Get_MinWidth
        Get_MinWidth = nMinWidth
    end function

    '// Get Heght
    function GetHeight
        'GetHeight = nHeight
    end function

    '// Get Width
    function GetWidth
        GetWidth = nWidth
    end function

    '// Set Heght
    function SetHeight(st, Height)
        Height = nHeight
    end function

    '// Set Width
    function SetWidth(st, Width)
        nWidth = Width
        initUI
    end function

    '// MoveTo
    function MoveTo(self, Left, Top)
        self.style.Left = Left
        self.style.Top = Top
    end function

    function Help
        showHelp sPathHelp
    end function

    '// Hide all Scriptlet's elements
    function Hide(self)
        'This Module alvais is visible
        'self.style.display = "none"
    end function

    '// Show all Scriptlet's elements
    function Show(self)
        'This Module alvais is visible
        'self.style.display = ""
    end function

'/////////// Specific functions //////////

    '// Get_ToolTitle
    '//
    function ToolTitle
        ToolTitle = PLUGIN_NAME + " " + PLUGIN_VER
    end function

    '// Tool Name
    '//
    function Get_ToolName
        Get_ToolName = PLUGIN_NAME
    end function
    function Put_ToolName(sName)
        PLUGIN_NAME = sName
        ToolLabel.SetTitle getToolTitle

        sPathHelp = "file:///" + sBasePath + "help\" + PLUGIN_NAME + ".chm"
    end function

    '// Tool version
    '//
    function Get_ToolVer
        Get_ToolVer = PLUGIN_VER
    end function
    function Put_ToolVer(sVer)
        PLUGIN_Ver = sVer
        ToolLabel.SetTitle getToolTitle
    end function

    '// Display all Scriptlets Controls
    function ShowAllScriptLets
        if bDisplay then ShowAllScriptLetsImpl
    end function

    '// Hide all Scriptlets Controls
    function HideAllScriptLets
        HideAllScriptLetsImpl
    end function

    '// Resize all Scriptlets Controls
    function ResizeAllScriplets
        if bDisplay then HideAllScriptLetsImpl
        ResizeAllScripletsImpl
        if bDisplay then ShowAllScriptLetsImpl
    end function

    function get_ImagePath
        get_ImagePath = sPathCmnImgs
    end function

    '// Convert string (32px) to number (32)
    function PixToI(sPix)
        PixToI = PixToI_Impl(sPix)
    end function

    function get_Display
        get_Display = bDisplay
    end function
end class

'///////////////////////////////////////
'// Constants //
dim PLUGIN_NAME '// TCW Plugin Tool
dim PLUGIN_VER  '// 1.0

dim bDisplay
bDisplay = TRUE

 '// LayOut Constants
const BorderWidth = 2		'// Border for AciveX elements
const ScrollBarWidth = 2	'// Internet palette's scroll Bar
const ScrollBarHeight = 15	'// Internet palette's scroll Bar
const MinHeight = 0
const MinWidth = 100
const SysBtnWidth = 18		'// btnStop, btnAbout
const HeadBarHeight = 21	'// DarkBlue Plugin "System" Bar

'//Global vars
dim sBasePath, sPathHelp, sPathCmnImgs, sPathCmnImgsURL	'// Directories

Dim WinX, WinY '// Window size
WinX = -1
WinY = -1

'// Extract path from (path + \name.html)
sBasePath = window.location.pathname
sBasePath = StrReverse(sBasePath)

sBasePath = Right(sBasePath, Len(sBasePath) - InStr(sBasePath, "\") + 1)
'// For VBScript 5.0/5.5 compatibility
if(ScriptEngineMajorVersion = 5 and ScriptEngineMinorVersion >= 5) then
    dim lastsym
    lastsym = Left(sBasePath, 1)
    if (lastsym = "\") then
        sBasePath = Right(sBasePath, Len(sBasePath) - 1)
    end if
    sBasePath = Right(sBasePath, Len(sBasePath) - InStr(sBasePath, "\") + 1)
end if

sBasePath = StrReverse(sBasePath)
' AALB 27/11/200 fix bug with empty space in path
 sBasePath = Replace( sBasePath, "%20", " "	)

'// For VBScript 3.0 compatibility
dim s
    s = Right(sBasePath, 1)
    if s <> "\" then
        sBasePath = Left(sBasePath , Len(sBasePath) - 1)
    end if

    s = Right(sBasePath, 1)
    if s <> "\" then
        sBasePath = Left(sBasePath , Len(sBasePath) - 1)
    end if

'// Build Help Path
'sPathHelp = "file:///" + sBasePath + "help\ID Keeper.chm"

'// Build Path to Common Images
sPathCmnImgs = sBasePath + "CommonImages\"
'// For VBScript 5.0/5.5 compatibility
if not (ScriptEngineMajorVersion = 5 and ScriptEngineMinorVersion >= 5) then
    sPathCmnImgs = Right(sPathCmnImgs, Len(sPathCmnImgs) - 1)
end if
sPathCmnImgsURL = "file:///" + sBasePath + "CommonImages\"

'// getToolTitle
'//
function getToolTitle
    getToolTitle = PLUGIN_NAME
end function

'// Convert string (32px) to number (32)
function PixToI_Impl(sPix)
    Dim SearchString, SearchChar, Pos, s
    if IsNumeric(sPix) then
        PixToI_Impl = CLng(sPix)
    else
        Pos = InStr(1, sPix, "px", 1)
        if Pos <> 0 then
            PixToI_Impl = CLng(Left(sPix, Pos - 1))
        end if
    end if
end function

'// Display all Scriptlets Controls
function ShowAllScriptLetsImpl
    dim s
    for each s in top.document.Applets
        if IsTCPlugin(s) then

            On Error Resume Next
            Err.Clear

            if s.IsShowable then s.Show(s)
            'if Err.Number > 0 then

        end if
    next
end function

'// Hide all Scriptlets Controls
function HideAllScriptLetsImpl
    dim s
    for each s in top.document.Applets
        if IsTCPlugin(s) then

            On Error Resume Next
            Err.Clear

            if s.IsShowable then s.Hide(s)

            'if Err.Number > 0 then

        end if
    next
end function

'// Resize all Scriptlets Controls
function ResizeAllScripletsImpl
    dim s, Width, Height

    '// Skip another properties
    if not bDisplay then
    InitUI
        exit function
    end if

    '// Horizontal sizes
    Width = getDocWidth
    for each s in top.document.Applets
        if IsTCPlugin(s) then

            On Error Resume Next
            Err.Clear

                if s.IsShowable and s.CanChangeWidth and Width<>0 then
                    s.SetWidth s, Width
                end if

            'if Err.Number > 0 then

            end if
        next

        '// Vertical sizes
        Height = getDocHeight

        '// Find non Changeable part dY
        dim dYConst, CountChng
        dYConst = 0
        CountChng = 0
        for each s in top.document.Applets
            if IsTCPlugin(s) then

            On Error Resume Next
            Err.Clear

                if s.IsShowable then
                    if s.CanChangeHeight then
                        CountChng = CountChng + 1
                    else
                        dYConst = dYConst + s.Height
                    end if
                end if

            'if Err.Number > 0 then

            end if
        next

        if CountChng <> 0 then
            dYConst = (Height - dYConst) / CountChng
        else
            dYConst = 0
        end if

        '// Set New Y Position
        Dim CurY
        CurY = 0
        for each s in top.document.Applets
            if IsTCPlugin(s) then

                On Error Resume Next
                Err.Clear

                if s.IsShowable then

                    s.MoveTo s, 0, CurY
                    if s.CanChangeHeight and dYConst<> 0 then
                        s.SetHeight s, dYConst
                    end if

                    CurY = CurY + s.Height

                end if

            'if Err.Number > 0 then

            end if
        next
    end function

'// BOOL isScriptVersionOK
function isScriptVersionOK
    dim ver, sVer, sMessage, iRes
    ver = CInt(ScriptEngineMajorVersion)
    sVer = CStr(ver)
    isScriptVersionOK = true

    if (ver < 5) then
        sMessage = "VBScript version " + sVer + " is detected in the system." +	vbCrLf
        sMessage = sMessage + PLUGIN_NAME + " needs version 5 or later." + vbCrLf
        sMessage = sMessage + "You can get incorrect result with earlier version of VBScript." + vbCrLf
        sMessage = sMessage + "Do you want to continue ?"
        iRes = MsgBox(sMessage, vbYesNo + vbInformation, "Plugin " + PLUGIN_NAME + " Warning")
        if (iRes = vbNo) then
            isScriptVersionOK = false
        end if
    end if
end function '// isScriptVersionOK

'// BOOL isInitUIOK
function isInitUIOK
    isInitUIOK = false
    initUI
    isInitUIOK = true
end function '// isInitUIOK

'// IsTCPlugin
'// Check: Scriptlet is TurboCad Plugin
function IsTCPlugin(st)
    On Error Resume Next
    Err.Clear
    IsTCPlugin = st.TCPlugin
    if Err.Number > 0 then IsTCPlugin = FALSE
end function

'// startUp
'// Check Script, TCW, Init all global vars
Sub startUp
    if not(isScriptVersionOK) then
        Exit sub
    end if

    if not(isInitUIOK) then
        Exit sub
    end if
end sub '// startUp

'// getDocHeight
function getDocHeight
    dim  DocHeight
    DocHeight = top.document.body.offsetHeight

    '// Check minimum sizes
    if (DocHeight < MinHeight) then
        DocHeight = MinHeight '// 200
    end if

    dim s, Min
    Min = MinHeight
    for each s in top.document.Applets
        if IsTCPlugin(s) then

            On Error Resume Next
            Err.Clear

            if (s.IsShowable) then Min = Min + s.MinHeight

            'if Err.Number > 0 then IsTCPlugin = FALSE

        end if
    next

    if (DocHeight < Min) then
        DocHeight = Min	'// 100
        top.document.body.scroll = ""
    else
        top.document.body.scroll = "no"
    end if

    getDocHeight = DocHeight' - HeadBarHeight
end function'// getDocHeight

'// getDocWidth
function getDocWidth
    dim  DocWidth
    DocWidth = top.document.body.offsetWidth
    DocWidth = DocWidth - ScrollBarWidth

    dim s, Min
    Min = MinWidth
    for each s in top.document.Applets
        if IsTCPlugin(s) then

            On Error Resume Next
            Err.Clear

            if (s.IsShowable and  Min < s.MinWidth) then Min = s.MinWidth

            'if Err.Number > 0 then IsTCPlugin = FALSE
        end if
    next

    if (DocWidth < Min) then
        DocWidth = Min	'// 100
    end if

    getDocWidth = DocWidth
end function'// getDocWidth

'// initUI
'//
sub initUI
    dim  DocWidth
    DocWidth = getDocWidth

    if (bDisplay) then
        '// Add Images
        With ToolBarImgList.ListImages
        .Clear
        .Add  ,"Start",		LoadPicture(sPathCmnImgs + "Start.bmp")
        .Add  ,"Stop",		LoadPicture(sPathCmnImgs + "Stop.bmp")
        .Add  ,"About",		LoadPicture(sPathCmnImgs + "About.bmp")
        End With

        Toolbar1.ImageList = ToolBarImgList

        '// Add Buttons
        With ToolBar1.Buttons
        .Clear
        .Add  (, "Label Name",,4).Width = DocWidth - 3* SysBtnWidth - Borderwidth - 4
        .Add (, "Start", ,,"Start").ToolTipText = "Start"
        .Add (, "Stop", ,,"Stop" ).ToolTipText = "Stop"
        .Add (, "About", ,,"About" ).ToolTipText = "About"
         End With
         ToolBar1.Buttons("Start").Enabled = 0
    end if

     ToolBar1.Buttons("Label Name").Width = DocWidth - 3* SysBtnWidth - Borderwidth - 4
     ToolLabel.width = DocWidth - 3* SysBtnWidth - Borderwidth - 7
end sub '// initUI

Sub About
dim sMessage
    sMessage = sMessage + "Plugin for TurboCAD" + vbCrLf
    'sMessage = sMessage + " " + vbCrLf
    sMessage = sMessage + PLUGIN_NAME + " v" + PLUGIN_VER + vbCrLf
    sMessage = sMessage + " " + vbCrLf
    sMessage = sMessage + "www.softdevspb.com" + vbCrLf

    call MsgBox(sMessage, vbOKOnly, "About")
end sub

'/////////// window events ////////////
'//
Sub window_onload
    startUp
end sub '// window_onload

Sub window_onhelp
    showHelp sPathHelp
end sub

Sub document_onhelp
    showHelp sPathHelp
end sub

Sub btnAbout_onclick
    showHelp sPathHelp
End Sub

-->
</SCRIPT>

<SCRIPT ID=clientEventHandlersVBS LANGUAGE=vbscript>
<!--

Sub Toolbar1_ButtonClick(Button)
    select case Button.Key
        case "Start"
            Button.Enabled = 0
            bDisplay = TRUE
            Toolbar1.Buttons("Stop").Enabled = 1
            ShowAllScriptLetsImpl
            ResizeAllScripletsImpl
            window.external.raiseEvent "ShowAll", 0

        case "Stop"
            Button.Enabled = 0
            bDisplay = FALSE
            Toolbar1.Buttons("Start").Enabled = 1
            HideAllScriptLetsImpl
            window.external.raiseEvent "HideAll", 0
        case "About"
            About
    end select
End Sub

-->
</SCRIPT>

</HEAD>

<BODY bgcolor=silver>

<!------------------ ToolBase Controls -------------------------->
<OBJECT classid=clsid:66833FE6-8583-11D1-B16A-00C0F0283628 height=24 id=Toolbar1
style="HEIGHT: 24px; LEFT: 0px; POSITION: absolute; TOP: 0px; WIDTH: 2000px; Z-INDEX: 105"
width=2000><PARAM NAME="_ExtentX" VALUE="42333"><PARAM NAME="_ExtentY" VALUE="508"><PARAM NAME="ButtonWidth" VALUE="487"><PARAM NAME="ButtonHeight" VALUE="466"><PARAM NAME="ToolTips" VALUE="1"><PARAM NAME="AllowCustomize" VALUE="1"><PARAM NAME="Wrappable" VALUE="0"><PARAM NAME="Appearance" VALUE="1"><PARAM NAME="HelpContextID" VALUE="0"><PARAM NAME="HelpFile" VALUE=""><PARAM NAME="Style" VALUE="1"><PARAM NAME="TextAlignment" VALUE="0"><PARAM NAME="ImageList" VALUE=""><PARAM NAME="DisabledImageList" VALUE=""><PARAM NAME="HotImageList" VALUE=""><PARAM NAME="_Version" VALUE="393216"><PARAM NAME="BorderStyle" VALUE="1"><PARAM NAME="MousePointer" VALUE="0"><PARAM NAME="Enabled" VALUE="1"><PARAM NAME="OLEDropMode" VALUE="0"></OBJECT>

<OBJECT classid=clsid:2C247F23-8591-11D1-B16A-00C0F0283628 id=ToolBarImgList
style="LEFT: 54px; POSITION: absolute; TOP: 379px; Z-INDEX: 106"><PARAM NAME="_ExtentX" VALUE="804"><PARAM NAME="_ExtentY" VALUE="804"><PARAM NAME="BackColor" VALUE="-2147483624"><PARAM NAME="ImageWidth" VALUE="16"><PARAM NAME="ImageHeight" VALUE="15"><PARAM NAME="MaskColor" VALUE="12632256"><PARAM NAME="UseMaskColor" VALUE="-1"><PARAM NAME="_Version" VALUE="393216"></OBJECT>

<!-- Label -->
<OBJECT height=16 id=ToolLabel name=ToolLabel
style="LEFT: 1px; POSITION: absolute; TOP: 1px; Z-INDEX: 109"
type=text/x-scriptlet width=190><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="StLabel.htm"></OBJECT>

</BODY>
</HTML>


Examples - Internet Palette Scripts - StCalculator.htm

StCalculator.htm

Internet Palette Scripts Example

<HTML>
<HEAD>
<META name=VI60_defaultClientScript content=VBScript>
<META name=StTC content=VBScript>
<TITLE>StCalculator</TITLE>

<SCRIPT ID=StCalculator Name=StCalculator LANGUAGE="VBScript">
option Explicit

'// About
Const StName = "StCalculator"
Const StVer = 1.0

'// Resize Behavior vars
dim bCanChangeWidth, bCanChangeHeight, bIsOverPos, IsShowable
bCanChangeWidth = FALSE
bCanChangeHeight = FALSE
bIsOverPos = FALSE
IsShowable = FALSE

const nMinHeight = 180
const nMinWidth  = 267
dim nHeight, nWidth
nHeight = 0
nWidth = 0

dim public_description
set public_description = new Interface

class Interface

    '// TCPlugin
    '// For Scriptlet check
    function TCPlugin
        TCPlugin = TRUE
    end function

    function GetName
        GetName = StName
    end function

    function GetVer
        GetVer = StVer
    end function

    function Get_CanChangeWidth
        Get_CanChangeWidth = bCanChangeWidth
    end function

    function Get_CanChangeHeight
        Get_CanChangeHeight = bCanChangeHeight
    end function

    function Get_IsOverPos
        Get_IsOverPos = bIsOverPos
    end function

    function Get_IsShowable
        Get_IsShowable = IsShowable
    end function

    function Put_IsShowable(b)
        IsShowable = b
    end function

    '// Min Heght
    function Get_MinHeight
        Get_MinHeight = nMinHeight
    end function

    '// Min Width
    function Get_MinWidth
        Get_MinWidth = nMinWidth
    end function

    '// Get Heght
    function GetHeight
        GetHeight = nHeight
    end function

    '// Get Width
    function GetWidth
        GetWidth = nWidth
    end function

    '// Set Heght
    function SetHeight(self, Height)
        Height = nHeight
    end function

    '// Set Width
    function SetWidth(self, Width)
        nWidth = Width
    end function

    '// MoveTo
    function MoveTo(self, Left, Top)
        self.style.Left = Left
        self.style.Top = Top
    end function

    '// Init all Scriptlet's elements
    function Init
        InitUI
        Show
    end function

    '// Hide all Scriptlet's elements
    function Hide(self)
        self.style.display = "none"
    end function

    '// Show all Scriptlet's elements
    function Show(self)
        self.style.display = ""
    end function

    '// Set Scriptlet's position
    function SetPos(nx1, ny1, nx2, ny2)
    end function

'////////////////////////////////
    function Put_CalculatorVal(str)
        'if Not IsNumeric(str) then exit function
        SetCalculatorValImpl(str)
    end function

    function Get_CalculatorVal
        Get_CalculatorVal = Document.Keypad.ReadOut.Value
    end function
end class

'// initUI
'//
sub initUI
end sub '// initUI

Const IN_MODE  = 0
Const FT_MODE  = 1
Const M_MODE   = 2
Const MM_MODE  = 3

Dim CurMode
CurMode = 0

Sub SetCalculatorValImpl(str)
    'Document.Keypad.ReadOut.Value = CDblSafe(str)
    FlagNewNum = false
    Document.Keypad.ReadOut.Value = str
end sub

'// Digit separator routine
Dim DigitChr, DigitChrBad

if IsNumeric("0.0") then
    DigitChr = "."
    DigitChrBad = ","
else
    DigitChr = ","
    DigitChrBad = "."
end if

function SetNumericDigit(str)
    if IsNumeric(str) then
        SetNumericDigit = str
    else
        SetNumericDigit = Replace(str, DigitChrBad, DigitChr)
    end if
end function

function IsValid(str)

    '// Check Numeric
    IsValid = true
    if (IsNumeric(str) or IsNumeric(SetNumericDigit(str))) then
        exit function
    end if

    '// Check Symbols
    On Error Resume Next
    Err.Clear

    dim res
    res = eval(str)

    '//	All Ok
    if Err.Number = 0 and (not IsEmpty(res)) then
        exit function
    end if

    dim ErStr
    'ErStr = "Error # " & CStr(Err.Number) & " " & Err.Description & Err.Source

    On Error Resume Next
       Err.Clear

    eval(SetNumericDigit(str))

    '//	All Ok
    if Err.Number = 0 and (not IsEmpty(res)) then
        exit function
    end if

    ErStr = "Invalid Value: " + vbCrLf + str
    MsgBox ErStr, vbInformation, StName

    IsValid = false
end function

function IsValidReadOut
    IsValidReadOut = IsValid(Document.Keypad.ReadOut.Value)
end function

function CDblSafe(Str)
    dim StrTmp
    StrTmp = Str

    '// Try Str as numeric string
    On Error Resume Next
    Err.Clear
    CDblSafe = CDbl(SetNumericDigit(StrTmp))
    if Err.Number = 0  and (not IsEmpty(CDblSafe)) then exit function'//	All Ok

    '// Try Str as symbols
    On Error Resume Next
    Err.Clear
    CDblSafe = eval(str)
    if Err.Number = 0 and (not IsEmpty(CDblSafe)) then exit function'//	All Ok

    '// Try Str as symbols and (.,)
    On Error Resume Next
    Err.Clear
    CDblSafe = eval(SetNumericDigit(StrTmp))
    if Err.Number = 0 and (not IsEmpty(CDblSafe)) then exit function'//	All Ok

    dim ErStr
    ErStr = "Invalid Value: " + vbCrLf + str
    MsgBox ErStr, vbInformation, StName
end function

dim ReadOutOld
ReadOutOld = ""
sub DoEvent(Op)
    dim ReadOut
    ReadOut = Document.Keypad.ReadOut.Value
    if (Op = "" or Op = "=") then
        if (ReadOutOld <> ReadOut)then
            window.external.raiseEvent Op, ReadOut
            ReadOutOld = ReadOut
        end if
    else
        window.external.raiseEvent Op, ReadOut
        ReadOutOld = ReadOut
    end if
end sub

' Module-level variables
Dim Accum		' Previous number (operand) awaiting operation
Dim FlagNewNum	' Flag to indicate a new number (operand) is being entered
Dim PrevOp	' Pending operation waiting for completion of second operand
FlagNewNum = false
PrevOp = "="

Sub NumPressed(Byval Num)
    If FlagNewNum Then
           Document.Keypad.Readout.Value  = Num
           FlagNewNum = False
    Else
        If Document.Keypad.Readout.Value = "0" Then
            Document.Keypad.Readout.Value = CStr(Num)
        Else
            Document.Keypad.ReadOut.Value= Document.Keypad.ReadOut.Value & CStr(Num)
        End If
    End If
End Sub

Sub Decimal_onClick()
    Dim curReadout
    curReadOut = Document.Keypad.ReadOut.Value
    If FlagNewNum Then
        curReadOut = "0."
        FlagNewNum = False
    Else
        If InStr(curReadOut, ".") = 0 Then
            curReadOut = curReadOut & "."
        End If
    End If
    Document.Keypad.ReadOut.Value = curReadOut
End Sub

Sub Plus_onClick()
    DoOperation "+"
End Sub

Sub Minus_onClick()
    DoOperation "-"
End Sub

Sub Multiply_onClick()
    DoOperation "*"
End Sub

Sub Divide_OnClick()
    DoOperation "/"
End Sub

Sub Equals_OnClick()
    DoOperation "="
End Sub

Sub DoOperation(Byval Op)

    if not IsValidReadOut then exit sub

    Dim Readout
    ReadOut = Document.Keypad.ReadOut.Value

    'if ((Op = "=") and (not Isnumeric(ReadOut))) then
    '	DoEvent ""

    '	Accum = Eval(ReadOut)
    '	Document.Keypad.ReadOut.Value = Accum

    '	DoEvent Op
    '	exit sub
    'end if

    If FlagNewNum and PrevOp <> "=" Then
        ' User is hitting op keys repeatedly, so don't do anything
    Else

        FlagNewNum = True
        Select Case PrevOp
        Case "+"
            Accum = CDblSafe(Accum) + CDblSafe(ReadOut)
        Case "-"
            Accum = CDblSafe(Accum) - CDblSafe(ReadOut)
        Case "/"

            '// Check
            On Error Resume Next
            Err.Clear

            Accum = CDblSafe(Accum) / CDblSafe(ReadOut)

            if Err.Number > 0 then
                MsgBox "Error:  " & Err.Description, vbInformation, StName
            end if

        Case "*"
            Accum = CDblSafe(Accum) * CDblSafe(ReadOut)

        Case Else
            Accum = CDblSafe(ReadOut)
        End Select

        if (PrevOp = "=") then
            DoEvent ""
        else
            DoEvent PrevOp
        end if

        Document.Keypad.ReadOut.Value = Accum

        if (Op = "=") then
            DoEvent "="
        else
            DoEvent ""
        end if
        PrevOp = Op

    End If
End Sub

Sub ClearEntry_onClick()
    ' Remove current number and reset state
    Document.Keypad.ReadOut.Value = "0"
    FlagNewNum = True
End Sub

Sub Clear_onClick()
    ' Clear accumulator and pending operation, and clear display
     Accum = 0
     PrevOp = ""
    ClearEntry_onClick
End Sub

Sub Neg_onClick()
    if not IsValidReadOut then exit sub
    Document.Keypad.ReadOut.Value = CDblSafe(Document.Keypad.ReadOut.Value) * -1
End Sub

Sub Percent_onClick()
    if not IsValidReadOut then exit sub
    DoEvent ""
    Document.Keypad.ReadOut.Value = (CDblSafe(Document.Keypad.ReadOut.Value) / 100) * Accum
    DoEvent "%"
    FlagNewNum = True
End Sub

Sub Sqrt_OnClick()
    if not IsValidReadOut then exit sub
    DoEvent ""

    '// Check
    On Error Resume Next
    Err.Clear

    Document.Keypad.ReadOut.Value = sqr(CDblSafe(Document.Keypad.ReadOut.Value))

    if Err.Number > 0 then
        MsgBox "Invalid argument for SQRT function", vbInformation, StName

    end if

    DoEvent "sqrt"
    FlagNewNum = True
End Sub

Sub DivByX_OnClick()
    if not IsValidReadOut then exit sub
    DoEvent ""

    '// Check
    On Error Resume Next
    Err.Clear

    Document.Keypad.ReadOut.Value = 1/(CDblSafe(Document.Keypad.ReadOut.Value))

    if Err.Number > 0 then
        MsgBox "Error: " & Err.Description, vbInformation, StName
    end if

    DoEvent "1/x"
    FlagNewNum = True
End Sub

Sub In_OnClick()
    if not IsValidReadOut then exit sub
    DoEvent ""
    Dim k
    Select Case CurMode
        Case IN_MODE
            'k = 0.0254
            'Document.Keypad.In.style.color = &H808080
            exit sub
        Case FT_MODE
            k = 0.3048
            Document.Keypad.ft.style.color = &H808080
        Case M_MODE
            k = 1
            Document.Keypad.M.style.color = &H808080
        Case MM_MODE
            k = 1/1000
            Document.Keypad.Mm.style.color = &H808080
    End Select
    Document.Keypad.In.style.color = 0

    k = k / 0.0254
    CurMode = IN_MODE
    Document.Keypad.ReadOut.Value = (CDblSafe(Document.Keypad.ReadOut.Value)* k)

    DoEvent "in"
    FlagNewNum = True
End Sub

Sub Ft_OnClick()
    if not IsValidReadOut then exit sub
    DoEvent ""
    Dim k
    Select Case CurMode
        Case IN_MODE
            k = 0.0254
            Document.Keypad.In.style.color = &H808080
        Case FT_MODE
            'k = 1/0.3048
            'Document.Keypad.ft.style.color = &H808080
            exit sub
        Case M_MODE
            k = 1
            Document.Keypad.M.style.color = &H808080
        Case MM_MODE
            k = 1/1000
            Document.Keypad.Mm.style.color = &H808080
    End Select
    Document.Keypad.ft.style.color = 0

    k = k / 0.3048
    CurMode = Ft_MODE
    Document.Keypad.ReadOut.Value = (CDblSafe(Document.Keypad.ReadOut.Value)* k)

    FlagNewNum = True
    DoEvent "ft"
End Sub

Sub m_OnClick()
    if not IsValidReadOut then exit sub
    DoEvent ""
    Dim k
    Select Case CurMode
        Case IN_MODE
            k = 0.0254
            Document.Keypad.In.style.color = &H808080
        Case FT_MODE
            k = 0.3048
            Document.Keypad.ft.style.color = &H808080
        Case M_MODE
            'k = 1
            'Document.Keypad.M.style.color = &H808080
            exit sub
        Case MM_MODE
            k = 1/1000
            Document.Keypad.Mm.style.color = &H808080
    End Select
    Document.Keypad.m.style.color = 0

    k = k * 1
    CurMode = M_MODE
    Document.Keypad.ReadOut.Value = (CDblSafe(Document.Keypad.ReadOut.Value)* k)

    FlagNewNum = True
    DoEvent "m"
End Sub

Sub mm_OnClick()
    if not IsValidReadOut then exit sub
    DoEvent ""
    Dim k
    Select Case CurMode
        Case IN_MODE
            k = 0.0254
            Document.Keypad.In.style.color = &H808080
        Case FT_MODE
            k = 0.3048
            Document.Keypad.ft.style.color = &H808080
        Case M_MODE
            k = 1
            Document.Keypad.M.style.color = &H808080
        Case MM_MODE
            'k = 1/1000
            'Document.Keypad.Mm.style.color = &H808080
            exit sub
    End Select
    Document.Keypad.mm.style.color = 0

    k = k * 1000
    CurMode = MM_MODE
    Document.Keypad.ReadOut.Value = (CDblSafe(Document.Keypad.ReadOut.Value)* k)

    FlagNewNum = True
    DoEvent "mm"
End Sub

Sub TABLE1_onkeydown
    if window.event.KeyCode = 13 then
        DoOperation "="
    else
        FlagNewNum = False
    end if
End Sub

-->
</SCRIPT>

<BODY bgcolor=#e6e6e6 style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small" scroll=no>

<!------------------ Specific Controls -------------------------->
<form Name="Keypad" action="" style="BORDER-BOTTOM-COLOR: gray"></B>
<TABLE bgColor=silver border=3 cellPadding=1 cellSpacing=5 height=6
style="LEFT:
0px; POSITION: absolute; TOP: 0px; Z-INDEX: 103" width =40 id=TABLE1>

  <TR>
    <TD align=middle colSpan=5>

    <INPUT name=ReadOut value=0 WIDTH="100%"
      style="FONT-FAMILY: sans-serif; FONT-SIZE: xx-small; WIDTH: 160px">

      </TD>
    <TD></TD>
    <TD><INPUT name=Clear type=button value="  C  " style="COLOR: maroon; FONT-SIZE: xx-small; WIDTH: 30px" width="30"></TD>
    <TD><INPUT name=ClearEntry type=button value="CE  " style ="COLOR: maroon; FONT-SIZE: xx-small; WIDTH: 30px" width="40"></TD></TR>
  <TR>
    <TD ><INPUT name=In type=button value="  in  " style="FONT-SIZE: xx-small; WIDTH: 30px" width="30" ></TD>
    <TD></TD>
    <TD><INPUT name=Seven onclick=NumPressed(7) type=button value="  7  " size=15 style="COLOR: blue; FONT-SIZE: xx-small; WIDTH: 30px"></TD>
    <TD><INPUT name=Eight onclick=NumPressed(8) type=button value="  8  " size=10 style="COLOR: blue; FONT-SIZE: xx-small; WIDTH: 30px" width="30" ></TD>
    <TD><INPUT name=Nine onclick=NumPressed(9) type=button value="  9  " style="COLOR: blue; FONT-SIZE: xx-small; WIDTH: 30px" width="30"></TD>
    <TD></TD>
    <TD ><INPUT name=Divide type=button value="   /   " style="COLOR: red; FONT-SIZE: xx-small; WIDTH: 30px" width="30"></TD>
    <TD ><INPUT name=Sqrt type=button value="sqrt  "  style ="COLOR: darkblue; FONT-SIZE: xx-small; WIDTH: 30px" width="30"></TD></TR>
  <TR>
    <TD ><INPUT name=Ft type=button value="  ft  " style="COLOR: gray; FONT-SIZE: xx-small; WIDTH: 30px" width="30"></TD>
    <TD></TD>

    <TD><INPUT name=Four onclick=NumPressed(4) type=button value="  4  " style="COLOR: blue; FONT-SIZE: xx-small; WIDTH: 30px" width="30"></TD>
    <TD><INPUT name=Five onclick=NumPressed(5) type=button value="  5  " style="COLOR: blue; FONT-SIZE: xx-small; WIDTH: 30px" width="30"></TD>
    <TD><INPUT name=Six onclick=NumPressed(6) type=button value="  6  " style="COLOR: blue; FONT-SIZE: xx-small; WIDTH: 30px"></TD>
    <TD></TD>
    <TD ><INPUT name=Multiply type=button value="  *  " style="COLOR: red; FONT-SIZE: xx-small; WIDTH: 30px" width="30"></TD>
    <TD ><INPUT name=DivByX type=button value="1/x   "   style ="COLOR: darkblue; FONT-SIZE: xx-small; WIDTH: 30px" width="30"></TD></TR>
  <TR>
    <TD ><INPUT name=M type=button value="  m  " style="COLOR: gray; FONT-SIZE: xx-small; WIDTH: 30px" width="30"></TD>
    <TD></TD>

    <TD><INPUT name=One onclick=NumPressed(1) type=button value="  1  " style="COLOR: blue; FONT-SIZE: xx-small; WIDTH: 30px"></TD>
    <TD><INPUT name=Two onclick=NumPressed(2) type=button value="  2  " style="COLOR: blue; FONT-SIZE: xx-small; WIDTH: 30px"></TD>
    <TD><INPUT name=Three onclick=NumPressed(3) type=button value="  3  " style="COLOR: blue; FONT-SIZE: xx-small; WIDTH: 30px"></TD>
    <TD></TD>
    <TD ><INPUT name=Plus type=button value="  +  " style="COLOR: red; FONT-SIZE: xx-small; WIDTH: 30px" width="30"></TD>
    <TD><INPUT name=Percent type=button value="  %  " style="COLOR: darkblue; FONT-SIZE: xx-small; WIDTH: 30px" width="30"></TD></TR>

  <TR>
    <TD ><INPUT name=Mm type=button value="mm  "  style ="COLOR: gray; FONT-SIZE: xx-small; WIDTH: 30px" width="30"></TD>
    <TD></TD>

    <TD><INPUT name=Zero onclick=NumPressed(0) type=button value="  0  " style="COLOR: blue; FONT-SIZE: xx-small; WIDTH: 30px"></TD>
    <TD><INPUT name=Decimal type=button value="   .  " style="COLOR: blue; FONT-SIZE: xx-small; WIDTH: 30px"></TD>
    <TD><INPUT name=Neg type=button value=" +/- " style="COLOR: blue; FONT-SIZE: xx-small; WIDTH: 30px" width="30"></TD>
    <TD></TD>
    <TD ><INPUT name=Minus type=button value="   -   " style="COLOR: red; FONT-SIZE: xx-small; WIDTH: 30px" width="30"></TD>
    <TD><INPUT name=Equals type=button value="  =  " style="COLOR: red; FONT-SIZE: xx-small; WIDTH: 30px" width="30"  accesskey==></TD></TR></TABLE>

</form>
</BODY></HTML>


Examples - Internet Palette Scripts - StDrawingTree.htm

StDrawingTree.htm

Internet Palette Scripts Example

<HTML>
<HEAD>
<META name=VI60_defaultClientScript content=VBScript>
<META name=StDrawingTree content=VBScript>
<TITLE>StTC</TITLE>

<SCRIPT ID=StDrawingTree Name=StDrawingTree LANGUAGE="VBScript">
option Explicit

'// About
Const StName = "StDrawingTree"
Const StVer = 1.0

'// resize Behavior vars
dim bCanChangeWidth, bCanChangeHeight, bIsOverPos, bIsShowable
bCanChangeWidth = TRUE
bCanChangeHeight = TRUE
bIsOverPos = FALSE
bIsShowable = TRUE

const nMinHeight = 100
const nMinWidth  = 100
dim nHeight, nWidth
nHeight = 0
nWidth = 0

dim public_description
set public_description = new Interface
class Interface

    '// TCPlugin
    '// For Scriptlet check
    function TCPlugin
        TCPlugin = TRUE
    end function

    function GetName
        GetName = StName
    end function

    function GetVer
        GetVer = StVer
    end function

    function Get_CanChangeWidth
        Get_CanChangeWidth = bCanChangeWidth
    end function

    function Get_CanChangeHeight
        Get_CanChangeHeight = bCanChangeHeight
    end function

    function Put_CanChangeHeight(b)
        bCanChangeHeight = b
    end function

    function Get_IsOverPos
        Get_IsOverPos = bIsOverPos
    end function

    function Get_IsShowable
        Get_IsShowable = bIsShowable
    end function

    '// Min Heght
    function Get_MinHeight
        Get_MinHeight = nMinHeight
    end function

    '// Min Width
    function Get_MinWidth
        Get_MinWidth = nMinWidth
    end function

    '// Get Heght
    function GetHeight
        GetHeight = nHeight
    end function

    '// Get Width
    function GetWidth
        GetWidth = nWidth
    end function

    '// Set Heght
    function SetHeight(self, Height)
        nHeight = Height
        self.Height = Height
        TreeView1.Style.Height = Height - 8
        ProgressBar1.Style.Top = Height - 9
    end function

    '// Set Width
    function SetWidth(self, Width)
        nWidth = Width
        self.Width = Width
        TreeView1.Style.Width = Width
        ProgressBar1.Style.Width = Width
    end function

    '// MoveTo
    function MoveTo(self, Left, Top)
        self.style.Left = Left
        self.style.Top = Top
    end function

    '// Init all Scriptlet's elements
    function Init
        InitUI
        Show
    end function

    '// Hide all Scriptlet's elements
    function Hide(self)
        self.style.display = "none"
    end function

    '// Show all Scriptlet's elements
    function Show(self)
        self.style.display = ""
    end function

    '// Set Scriptlet's position
    function SetPos(nx1, ny1, nx2, ny2)
    end function

'//////////////////// specific ///////////////////////////
    function DoDwgLog(bSelectOnly, bChilds, bVertices, sFiltr)
        DoDwgLog = DoLog(bSelectOnly, bChilds, bVertices, sFiltr)
    end function

    function ItemName(Node)
        ItemName = NodeName(Node)
    end function

    function ItemID(Node)
        ItemID = NodeID(Node)
    end function

    function ItemSubID(Node)
        ItemSubID = NodeSubID(Node)
    end function

    function Get_LastSelNodeIndex
        Get_LastSelNodeIndex = LastSelNodeIndex
    end function

    function Put_LastSelNodeIndex(Index)
        LastSelNodeIndex = Index
    end function

    '//////// TreeView Routine /////////
    function Get_SelNodeIndex
        Get_SelNodeIndex = TreeView1.SelectedItem.Index
    end function

    '//////// TreeView Routine /////////
    function NodeClick
        TreeView1_Click
    end function

    function NodeDblClick
        TreeView1_DblClick
    end function
    function NodeDelete
        NodeDeleteImpl
    end function

    function ClearContent
        '// Collaps Tree if need
        if (TreeNodes.Count > 0) then
            if (LoadingTime > 2) or not(TreeNodes.Item(1).Visible) then '// if Root is visible
                TreeNodes.Item(1).Expanded = false
            End if
        End if
        TreeNodes.Clear
    end function

    function Get_VerticesCount
        Get_VerticesCount = nVerticesCount
    end function

    function Get_GraphicsCount
        Get_GraphicsCount = nGraphicsCount
    end function

    function SelectAll
        SelectAllImpl
    end function

end class

'// initUI
'//
sub initUI
end sub '// initUI

Sub window_onload
    set TreeNodes = Nothing
    set TreeNodes = TreeView1.Nodes

    'TreeView1.Style.Height = 300
    'TreeView1.Font = "Verdana, Arial, Helvetica"
    TreeView1.Font.Size = 8
End Sub

dim nGraphicsCount, nVerticesCount

dim bAddVerteces
bAddVerteces = true

dim strTypes

'// DrawingView Specific
dim bDoLogYetIsRun		'  Prevent from multi entries in "DoLog"
bDoLogYetIsRun = false
dim LoadingTime		'determine the time it takes to scan selection (sec)
LoadingTime = 0

const PAPER_SPACE = 0
const MODEL_SPACE = 1

dim LastSelNodeIndex
dim GrSelectID, GrLastSelectID
dim TreeNodes
dim CountTopLevelGr
dim DrawingTileMode

dim bBlockAdd
bBlockAdd = false

'// Event routine
const EventBeforeExit = 1
const EventDrawingBeforeClose = 32
const EventMouseDown = 1024
const EventSelectionChange = 32768
const EventStartNewTool = 262144

const MaxNodeCount = 32000
sub WarningMaxNode(NumNode)
    Alert "To many nodes: " + CStr(NumNode) + vbCrLf + "Try off Vertices"
end sub

'// - DeleteVertices -
'Sub DeleteVertices(Gr, NumNode)
'	Dim node, child
'	set nodes = TreeNodes.Item(NumNode).
'
'	For each child in  Count
'		TreeNodes.Add NumNode, 4, , StTC.VERTEX_NAME + " " + Cstr(i + 1)
'	Next
'
'	set node = nothing
'end sub '// DeleteVertices

'// - AddVertices -
Sub AddVertices(Gr, NumNode)
    if NumNode > MaxNodeCount then
        WarningMaxNode(NumNode)
        exit sub
    end if

    Dim i, Count, sName
    Gr.Vertices.UseWorldCS = true

    sName = StTC.VERTEX_NAME + " "
    Count = Gr.Vertices.Count - 1
    For i = 0 To Count

        TreeNodes.Add NumNode, 4, , sName + Cstr(i + 1)

    Next
    nVerticesCount = nVerticesCount + Count + 1
end sub '// AddVertices

'// - AddMatrix -
Sub AddMatrix(Gr, NumNode)
    if NumNode > MaxNodeCount then
        WarningMaxNode(NumNode)
        exit sub
    end if

    TreeNodes.Add NumNode, 4, ,StTC.LOCALUCS_NAME
end sub '// AddVertices

'// Recursive function
dim Level, ValueOld
'// - AddNode -
Function AddNode (GrGrs, NumNode)
    if NumNode > MaxNodeCount then
        WarningMaxNode(NumNode)
        AddNode = Count
        exit Function
    end if

    Dim node, str, Gr, Count, i, GrType
    Count = 0
    Level = Level + 1
    i = 0
    For Each Gr in GrGrs

        nGraphicsCount = nGraphicsCount + 1
        GrType = UCase(Gr.Type)

        if Level = 1 then i = i+1

        '// Check Graphic Type
        if 	(Level = 1) then
            if ((strTypes = StTC.ALLTYPES_NAME) or (strTypes  = GrType)) or bBlockAdd then
                '// Count for Info
                Count = Count + 1
                Set node = TreeNodes.Add(NumNode, 4, , GrType)
                str = CStr(Gr.ID)
                node.Tag = str

                '// Add Block Name
                if GrType = "INSERT" then _
                    TreeNodes.Add node.Index, 4, ,StTC.BLOCK_NAME + " " + Gr.Block.Name

                '// Add Matrix
                if DrawingTileMode = MODEL_SPACE and GrType<>StTC.DATA_NAME then _
                     AddMatrix Gr.Graphics, node.Index

                '//	Add Graphic nodes
                if Gr.Graphics.Count > 0 then _
                    AddNode Gr.Graphics, node.Index '// Go to recursion

                '// Add Vertice nodes
                if bAddVerteces and Gr.Vertices.Count > 0 then
                    if Gr.Vertices.Count > 0 then _
                        AddVertices Gr, node.Index
                End if
            End if
        else
                '// Count for Info
                Count = Count + 1
                Set node = TreeNodes.Add(NumNode, 4, , GrType)
                str = CStr(Gr.ID)
                node.Tag = str

                '// Add Block Name
                if GrType = "INSERT" then _
                    TreeNodes.Add node.Index, 4, ,StTC.BLOCK_NAME + " " + Gr.Block.Name

                '// Add Matrix
                if DrawingTileMode = MODEL_SPACE and GrType<>StTC.DATA_NAME then _
                     AddMatrix Gr.Graphics, node.Index

                '//	Add Graphic nodes
                if Gr.Graphics.Count > 0 then _
                    AddNode Gr.Graphics, node.Index '// Go to recursion

                '// Add Vertice nodes
                if bAddVerteces and Gr.Vertices.Count > 0 then
                    if Gr.Vertices.Count > 0 then _
                        AddVertices Gr, node.Index
                End if
        End if

        dim val
        val = (100*i) / CountTopLevelGr
        if ValueOld < val then
            if val > 100 then
                val = 100
            end if
            ProgressBar1.Value = val
            ValueOld = val
        end if
    Next
    AddNode = Count
    Level = Level - 1
End Function

Sub ClearControlsContent
    '// Collaps Tree if need
    if (TreeNodes.Count > 0) then
        if (LoadingTime > 2) or not(TreeNodes.Item(1).Visible) then '// if Root is visible
            TreeNodes.Item(1).Expanded = false
        End if
    End if
    TreeNodes.Clear

end sub

'// - DoLog -
'// Scan selection sctucturies
function DoLog(bSelectOnly, bChilds, bVertices, sFiltr)
    Dim Drawings, ActDrawing, Grs, Gr, Count, str
    DoLog = FALSE

    bAddVerteces = bVertices

    '//	Prevent from multiplay entries
    if bDoLogYetIsRun then
        exit function
        alert "bDoLogYetIsRun"
    end if
    bDoLogYetIsRun = true

    '// Scan selection
    nGraphicsCount = 0
    nVerticesCount = 0

    '// Check Drawings Count
    Set Drawings = StTC.objApp.Drawings
    if Drawings.Count = 0 then
        ClearControlsContent
        Set Drawings = Nothing
        bDoLogYetIsRun = false
        exit function
    end if
    Set Drawings = Nothing

    '// OPrevent from "Close Drawing"
    On Error Resume Next
    Err.Clear
    Set ActDrawing = StTC.objApp.ActiveDrawing
    if Err.Number > 0 then
        ClearControlsContent
        bDoLogYetIsRun = false
        exit function
    end if

    if bSelectOnly then
        Set Grs=ActDrawing.Selection
    else
        Set Grs=ActDrawing.Graphics
    end if

    '// Init Vars
    if Grs.Count = 1 then
        GrSelectID = Grs.Item(0).ID
    else
        GrSelectID = -1
    End if

    if GrSelectID <> GrLastSelectID or GrSelectID = -1 then
        LastSelNodeIndex = -1
    End if

    '// Clear TreeView, ListView
    ClearControlsContent

    '// Reset ToolBar
    if Grs.Count = 0 then
        'UpdateToolBarUI
    End if

    '// Fill Graphics Tree
    CountTopLevelGr = Grs.Count

    'strTypes = Combo.item(Combo.selectedIndex).Text
    strTypes = sFiltr
    'strTypes = StTC.ALLTYPES_NAME
    TreeNodes.Add  , , , StTC.ROOT_NAME + " ( " + CStr(Grs.Count) + " Items found )"

    '// Asc Drawing Mode
    if 	ActDrawing.Properties("TileMode") = 0 then
        DrawingTileMode = PAPER_SPACE
    else
        DrawingTileMode = MODEL_SPACE
        if (not bSelectOnly) and (strTypes = StTC.ALLTYPES_NAME or strTypes = StTC.UCS_NAME) then
            TreeNodes.Add  , , , StTC.UCS_NAME
        end if
    end if

    if CountTopLevelGr = 0 and ActDrawing.Blocks.count = 0 then
        TreeNodes.Item(1).Selected = true
        bDoLogYetIsRun = false
        DoLog = TRUE
        exit function
    end if

    Level = 0
    ValueOld = 0

    '// Time to scan selection
    Dim BeginTime, EndTime
    BeginTime = Timer

    str = CStr(AddNode (Grs, 1))

    EndTime = Timer
    LoadingTime = EndTime - BeginTime

    TreeNodes.Item(1).Text = StTC.ROOT_NAME + " ( " + str + " Items found )"

    ProgressBar1.Value = 0
    ProgressBar1.Enabled = 0
    GrLastSelectID = GrSelectID

    '// Add Blocks to Graphics Tree
    if (not bSelectOnly) and (strTypes = StTC.ALLTYPES_NAME or strTypes = StTC.BLOCK_NAME) then
        Dim Blocks, Block, BlocksCount, NodeBlock, i
        Set Blocks = ActDrawing.Blocks
        BlocksCount = Blocks.Count
        if (BlocksCount > 0) then
            bBlockAdd = true
            For i = 0 To (BlocksCount - 1)
                'For Each Block in Blocks '// TODO - Hung up
                Set Block = Blocks.Item(i)
                CountTopLevelGr = BlocksCount
                 Level = 0
                ValueOld = 0
                Set NodeBlock = TreeNodes.Add(, , , StTC.BLOCK_NAME + " " + Block.Name)
                ProgressBar1.Enabled = 1
                str = CStr(AddNode (Block.Graphics, NodeBlock.Index))
                ProgressBar1.Value = 0
                ProgressBar1.Enabled = 0
                Set Block = Nothing
            Next
            bBlockAdd = false
        end if
        Set Blocks = Nothing
    end if

    '// Expand Root
    if TreeNodes.Count > 0 then
        TreeNodes.Item(1).Expanded = true
        TreeNodes.Item(1).Selected = true
    End if

    '// Expand First Graphic
    if Grs.Count = 1 then
        '// Restore selected node
        if LastSelNodeIndex > -1 then
            TreeNodes.Item(LastSelNodeIndex).Expanded = true
            TreeNodes.Item(LastSelNodeIndex).Selected = true
        else
            TreeNodes.Item(2).Expanded = true
            TreeNodes.Item(2).Selected = true
        End if
    End if

    Set Grs = Nothing
    Set ActDrawing = Nothing
    bDoLogYetIsRun = false
    DoLog = TRUE
end function '// DoLog

function NodeName(Node)
    NodeName = StTC.FindNodeName(node.Text)
end function

function NodeID(Node)
    Select Case NodeName(node)
        Case StTC.LOCALUCS_NAME    '//	Matrix Action
               NodeID = CLng(node.Parent.Tag)

        Case StTC.VERTEX_NAME    '//	Vertex Action
               NodeID = CLng(node.Parent.Tag) ',  CLng(StTC.FindNodeInfoStr(node.Text)) - 1)

        Case StTC.DATA_NAME
            NodeID = CLng(node.Tag)

        Case StTC.ROOT_NAME  '//	Root Action
               NodeID = 0

        Case StTC.UCS_NAME  '//	UCS Action
               NodeID = 0

        Case StTC.BLOCK_NAME  '//	Block Action
               'call BlockInfo

        Case Else '// Any Graphic Action
            NodeID = CLng(node.Tag)
     End Select
end function

'// For Vertex Only
function NodeSubID(Node)
    Select Case NodeName(node)
        Case StTC.VERTEX_NAME    '//	Vertex Action
               NodeSubID = CLng(StTC.FindNodeInfoStr(node.Text)) - 1
        Case Else '// Any Graphic Action
            NodeSubID = 0
     End Select
end function

sub NodeDeleteImpl
    dim ObjName, vs, Gr, Grs,  node, View, NodeParent, sMessage, iRes
    set node = TreeNodes.Item(LastSelNodeIndex)
    ObjName = NodeName(node)

    '// Vetrtex
    if 	ObjName = StTC.VERTEX_NAME then
        set Grs = StTC.GraphicsCollection
        set Gr = Grs.GraphicFromID(CLng(node.Parent.Tag))

        '// Check: ReadOnly
        if (not StTC.GraphicIsEditable(Gr)) then
            sMessage = ""
            sMessage = sMessage + "Graphic is Read Only. Program work may be not stable." + vbCrLf
            sMessage = sMessage + "It is recommended to save your work." + vbCrLf
            sMessage = sMessage + "Do you want to continue ?"
            iRes = MsgBox(sMessage, vbYesNo + vbInformation, " Warning")
            if (iRes = vbNo) then
                exit sub
            end if
        end if

        '// Check: Graphic Can Delete Vertices
        if (not StTC.GraphicCanDeleteVertices(Gr)) then
            sMessage = ""
            sMessage = sMessage + "This vertex is auxiliary. Program work may be not stable." + vbCrLf
            sMessage = sMessage + "It is recommended to save your work." + vbCrLf
            sMessage = sMessage + "Do you want to continue ?"
            iRes = MsgBox(sMessage, vbYesNo + vbInformation, " Warning")
            if (iRes = vbNo) then
                exit sub
            end if
        end if

        '// Check: Vertices	Count
        if (Gr.Vertices.Count < 3) then
            sMessage = ""
            sMessage = sMessage + "Object having less than 2 vertices may be incorrect." + vbCrLf
            sMessage = sMessage + "It is recommended to save your work." + vbCrLf
            sMessage = sMessage + "Do you want to continue ?"
            iRes = MsgBox(sMessage, vbYesNo + vbInformation, " Warning")
            if (iRes = vbNo) then
                exit sub
            end if
        end if

        set vs = Gr.Vertices
        call vs.Remove(NodeSubID(Node))

        set NodeParent = node.Parent

        dim n
        n =  node.index
        with TreeNodes
            while n <> Node.LastSibling.Index
                    if NodeName(.Item(n)) = StTC.VERTEX_NAME then
                        .Item(n).Text = StTC.VERTEX_NAME + " " + Cstr(NodeSubID(.Item(n)))
                    end if
                    n = TreeNodes.Item(n).Next.Index
            wend
                if NodeName(.Item(n)) = StTC.VERTEX_NAME then
                    .Item(n).Text = StTC.VERTEX_NAME + " " + Cstr(NodeSubID(.Item(n)))
                end if
        End With
        TreeNodes.Remove(node.Index)

            if Gr.Visible then
                set View = StTC.View
                Gr.Draw View
                set View = nothing
            end if

            TreeView1.Refresh

            set Grs = nothing
            set Gr = nothing
            set vs = nothing
            set NodeParent = nothing

        '// IsGraphic
        else
            dim GrParent
            set Gr = StTC.objApp.ActiveDrawing.Graphics.GraphicFromID(CLng(node.Tag))

            '// Check: ReadOnly
            if (not StTC.GraphicIsEditable(Gr)) then
                sMessage = ""
                sMessage = sMessage + "Graphic is Read Only. Program work may be not stable." + vbCrLf
                sMessage = sMessage + "It is recommended to save your work." + vbCrLf
                sMessage = sMessage + "Do you want to continue ?"
                iRes = MsgBox(sMessage, vbYesNo + vbInformation, " Warning")
                if (iRes = vbNo) then
                    exit sub
                end if
            end if

            if (not StTC.GraphicCanDeleteChildrens(Gr)) then
                sMessage = "Graphic is auxiliary. "
                sMessage = sMessage + "Program work may be not stable." + vbCrLf
                sMessage = sMessage + "It is recommended to save your work." + vbCrLf
                sMessage = sMessage + "Do you want to continue ?"
                iRes = MsgBox(sMessage, vbYesNo + vbInformation, " Warning")
                if (iRes = vbNo) then
                    exit sub
                end if
            end if

            set GrParent = Gr.Parent
            GrParent.Graphics.Remove(Gr.Index)

            if Gr.Visible then
                Gr.Unselect
                set View = StTC.View
                if NodeName(node.Parent) = StTC.ROOT_NAME then
                    View.Refresh
                else
                    GrParent.Draw View
                end if

                set View = nothing
            end if

            Gr.Delete
            set Gr = nothing
            set GrParent = nothing
            TreeNodes.Remove(node.Index)
        end if

        set node = nothing
        LastSelNodeIndex = TreeView1.SelectedItem.Index
        TreeView1_Click
end sub	'//NodeDeleteImpl

sub SelectAllImpl

    if StTC.ActiveDrawing.Graphics.Count > 0 then
        if strTypes = StTC.ALLTYPES_NAME then
            StTC.ActiveDrawing.Graphics.Select

            dim v
            for each v in StTC.ActiveDrawing.Views
                v.Refresh
            next

            exit sub
        end if

        dim n, Nodes, ActDrawing
        set Nodes = TreeView1.Nodes

        StTC.ActiveDrawing.Selection.Unselect
        for each n in Nodes
            if n.index <> 1 and (not IsEmpty(n.Parent)) then '// Root
                if StTC.IsGraphicName(n.Text) then
                    if n.Parent.index = 1 then '// Parent = Root

                        dim g
                        set g = StTC.ActiveDrawing.Graphics.GraphicFromID(n.Tag)
                        if g.Visible then
                            g.Select
                            g.Draw
                        end if
                        set g = nothing

                    end if
                end if
            end if
        next
        set Nodes = nothing
    end if
end sub

'Sub document_onkeydown
'	Alert 1
'	window.external.bubbleEvent
'End Sub

'Sub TreeView1_onkeydown
'End Sub

-->
</SCRIPT>

<SCRIPT ID=clientEventHandlersVBS LANGUAGE=vbscript>
<!--

Sub TreeView1_Click
    if TreeNodes.Count = 0 then exit sub
    LastSelNodeIndex = TreeView1.SelectedItem.Index
    window.external.raiseEvent "TreeView_Click", TreeView1.SelectedItem
End Sub

Sub TreeView1_DblClick
    if TreeNodes.Count = 0 then	exit sub
    LastSelNodeIndex = TreeView1.SelectedItem.Index
    window.external.raiseEvent "TreeView_DblClick", TreeView1.SelectedItem
End Sub

Sub TreeView1_KeyUp(Key, Shift)
    if TreeNodes.Count = 0 then	exit sub
    window.external.raiseEvent "TreeView_KeyUp", TreeView1.SelectedItem
    LastSelNodeIndex = TreeView1.SelectedItem.Index
end sub

'Sub TreeView1_KeyDown(Key, Shift)
'	if Shift = 2 then
'		window.external.raiseEvent "TreeView_KeyDown", Key
'	end if
'End Sub

-->
</SCRIPT>

<BODY bgcolor=silver style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small">

<!-- StTC -->
<OBJECT height=0 id=StTC name=StTC
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 104"
type=text/x-scriptlet width=0><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="StTC.htm"></OBJECT>

<!-- TreeView1 -->
<OBJECT classid=clsid:C74190B6-8589-11D1-B16A-00C0F0283628 id=TreeView1
style="HEIGHT: 280px; LEFT: 0px; POSITION: absolute; TOP: 0px; WIDTH: 255px; Z-INDEX: 99"
VIEWASTEXT><PARAM NAME="_ExtentX" VALUE="5398"><PARAM NAME="_ExtentY" VALUE="5927"><PARAM NAME="_Version" VALUE="393217"><PARAM NAME="HideSelection" VALUE="0"><PARAM NAME="Indentation" VALUE="0"><PARAM NAME="LabelEdit" VALUE="1"><PARAM NAME="LineStyle" VALUE="1"><PARAM NAME="PathSeparator" VALUE="\"><PARAM NAME="Sorted" VALUE="0"><PARAM NAME="Style" VALUE="6"><PARAM NAME="Checkboxes" VALUE="0"><PARAM NAME="FullRowSelect" VALUE="0"><PARAM NAME="HotTracking" VALUE="1"><PARAM NAME="Scroll" VALUE="1"><PARAM NAME="SingleSel" VALUE="0"><PARAM NAME="ImageList" VALUE=""><PARAM NAME="BorderStyle" VALUE="0"><PARAM NAME="Appearance" VALUE="1"><PARAM NAME="MousePointer" VALUE="0"><PARAM NAME="Enabled" VALUE="1"><PARAM NAME="OLEDragMode" VALUE="1"><PARAM NAME="OLEDropMode" VALUE="1"></OBJECT>

<!-- ProgressBar1 -->
<OBJECT classid=clsid:35053A22-8589-11D1-B16A-00C0F0283628 id=ProgressBar1
style="HEIGHT: 9px; LEFT: 0px; POSITION: absolute; TOP: 279px; WIDTH: 255px; Z-INDEX: 107"
VIEWASTEXT><PARAM NAME="_ExtentX" VALUE="5398"><PARAM NAME="_ExtentY" VALUE="191"><PARAM NAME="_Version" VALUE="327682"><PARAM NAME="BorderStyle" VALUE="0"><PARAM NAME="Appearance" VALUE="0"><PARAM NAME="MousePointer" VALUE="0"><PARAM NAME="Enabled" VALUE="0"><PARAM NAME="OLEDropMode" VALUE="0"><PARAM NAME="Min" VALUE="0"><PARAM NAME="Max" VALUE="100"></OBJECT>

</BODY>
</HTML>


Examples - Internet Palette Scripts - StLabel.htm

StLabel.htm

Internet Palette Scripts Example

<HTML>
<HEAD>
<META name=VI60_defaultClientScript content=VBScript>
<META name=StTC content=VBScript>
<TITLE>Label</TITLE>

<SCRIPT ID=Base Name=Base LANGUAGE="VBScript">
option Explicit

dim public_description
set public_description = new Interface

class Interface
    function SetTitle(Title)
        LabelAboutID.innerText = Title
    end function
end class

-->
</SCRIPT>

<BODY bgcolor=silver>

<P align=left id=LabelAboutID
style="BACKGROUND-COLOR: silver;
COLOR: navy; FONT-FAMILY: sans-serif; FONT-SIZE: xx-small; FONT-STYLE: normal;
FONT-WEIGHT: normal;
HEIGHT: 21px; LEFT: 22px; POSITION: absolute; TEXT-DECORATION: none; TOP: -1px; VERTICAL-ALIGN: middle; WIDTH: 257px; Z-INDEX: 100">TC Plugin&nbsp; is loading</P>

<IMG alt="" src="..\CommonImages\Plugin_label.bmp"
style="LEFT: 0px; POSITION: absolute; TOP: -1px; Z-INDEX: 101">

</BODY>
</HTML>


Examples - Internet Palette Scripts - StListView.htm

StListView.htm

Internet Palette Scripts Example

<SCRIPT ID=clientEventHandlersVBS LANGUAGE=vbscript>
<!--

Sub ListView1_DblClick

    if ListView1.ListItems.Count = 0 then
        exit sub
    end if
    window.external.raiseEvent "DblClick", ListView1.SelectedItem.ListSubItems.Item(1).Text

End Sub

-->
</SCRIPT>
<HTML>
<HEAD>
<META name=VI60_defaultClientScript content=VBScript>
<META name=StDrawingTree content=VBScript>
<TITLE>StTC</TITLE>

<SCRIPT ID=StDrawingTree Name=StDrawingTree LANGUAGE="VBScript">
option Explicit

'// About
Const StName = "StListView"
Const StVer = 1.0

'// resize Behavior vars
dim bCanChangeWidth, bCanChangeHeight, bIsOverPos, bIsShowable
bCanChangeWidth = FALSE
bCanChangeHeight = TRUE
bIsOverPos = FALSE
bIsShowable = TRUE

const nMinHeight = 100
const nMinWidth  = 100
dim nHeight, nWidth
nHeight = 0
nWidth = 0

dim public_description
set public_description = new Interface
class Interface

    '// TCPlugin
    '// For Scriptlet check
    function TCPlugin
        TCPlugin = TRUE
    end function

    function GetName
        GetName = StName
    end function

    function GetVer
        GetVer = StVer
    end function

    function Get_CanChangeWidth
        Get_CanChangeWidth = bCanChangeWidth
    end function

    function Get_CanChangeHeight
        Get_CanChangeHeight = bCanChangeHeight
    end function

    function Put_CanChangeHeight(b)
        bCanChangeHeight = b
    end function

    function Get_IsOverPos
        Get_IsOverPos = bIsOverPos
    end function

    function Get_IsShowable
        Get_IsShowable = bIsShowable
    end function

    function Put_IsShowable(b)
        bIsShowable = b
    end function

    '// Min Heght
    function Get_MinHeight
        Get_MinHeight = nMinHeight
    end function

    '// Min Width
    function Get_MinWidth
        Get_MinWidth = nMinWidth
    end function

    '// Get Heght
    function GetHeight
        GetHeight = nHeight
    end function

    '// Get Width
    function GetWidth
        GetWidth = nWidth
    end function

    '// Set Heght
    function SetHeight(self, Height)
        nHeight = Height
        self.Height = Height
        ListView1.Style.Height = Height
    end function

    '// Set Width
    function SetWidth(self, Width)
        nWidth = Width
        self.Width = Width
        ListView1.Style.Width = Width
        ListView1.Style.Width = Width
    end function

    '// MoveTo
    function MoveTo(self, Left, Top)
        self.style.Left = Left
        self.style.Top = Top
    end function

    '// Init all Scriptlet's elements
    function Init
        InitUI
        Show
    end function

    '// Hide all Scriptlet's elements
    function Hide(self)
        self.style.display = "none"
    end function

    '// Show all Scriptlet's elements
    function Show(self)
        self.style.display = ""
    end function

    '/////////// Specific /////////////
    function Get_ListView
        set Get_ListView = ListView1
    end function

end class

'// initUI
'//
sub initUI
end sub '// initUI

Sub window_onload
End Sub

-->
</SCRIPT>

<BODY bgcolor=silver style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small">

<!-- ListView1 -->
<OBJECT classid=clsid:BDD1F04B-858B-11D1-B16A-00C0F0283628 id=ListView1
style="HEIGHT: 151px; LEFT: -1px; POSITION: absolute; TOP: 1px; WIDTH: 270px; Z-INDEX: 105"
VIEWASTEXT><PARAM NAME="_ExtentX" VALUE="5715"><PARAM NAME="_ExtentY" VALUE="3196"><PARAM NAME="SortKey" VALUE="0"><PARAM NAME="View" VALUE="3"><PARAM NAME="Arrange" VALUE="2"><PARAM NAME="LabelEdit" VALUE="0"><PARAM NAME="SortOrder" VALUE="0"><PARAM NAME="Sorted" VALUE="0"><PARAM NAME="MultiSelect" VALUE="0"><PARAM NAME="LabelWrap" VALUE="0"><PARAM NAME="HideSelection" VALUE="-1"><PARAM NAME="HideColumnHeaders" VALUE="0"><PARAM NAME="OLEDragMode" VALUE="0"><PARAM NAME="OLEDropMode" VALUE="0"><PARAM NAME="AllowReorder" VALUE="-1"><PARAM NAME="Checkboxes" VALUE="0"><PARAM NAME="FlatScrollBar" VALUE="0"><PARAM NAME="FullRowSelect" VALUE="-1"><PARAM NAME="GridLines" VALUE="0"><PARAM NAME="HotTracking" VALUE="-1"><PARAM NAME="HoverSelection" VALUE="-1"><PARAM NAME="PictureAlignment" VALUE="0"><PARAM NAME="TextBackground" VALUE="0"><PARAM NAME="_Version" VALUE="393217"><PARAM NAME="ForeColor" VALUE="-2147483640"><PARAM NAME="BackColor" VALUE="-2147483643"><PARAM NAME="BorderStyle" VALUE="1"><PARAM NAME="Appearance" VALUE="1"><PARAM NAME="MousePointer" VALUE="0"><PARAM NAME="Enabled" VALUE="1"><PARAM NAME="NumItems" VALUE="0"></OBJECT>

</BODY>
</HTML>


Examples - Internet Palette Scripts - StObjectBase.htm

StObjectBase.htm

Internet Palette Scripts Example

<HTML>
<HEAD>
<META name=VI60_defaultClientScript content=VBScript>
<META name=StObjectBase content=VBScript>
<TITLE>StTC</TITLE>

<SCRIPT ID=Base Name=Base LANGUAGE="VBScript">
option Explicit

'// About
Const StName = "StObjectBase"
Const StVer = 1.0

'// resize Behavior vars
dim bCanChangeWidth, bCanChangeHeight, bIsOverPos, bIsShowable
bCanChangeWidth = TRUE
bCanChangeHeight = FALSE
bIsOverPos = FALSE
bIsShowable = TRUE

const nMinHeight = 200
const nMinWidth  = 200
dim nHeight, nWidth
nHeight = 0
nWidth = 0

dim public_description
set public_description = new Interface
class Interface

    '// TCPlugin
    '// For Scriptlet check
    function TCPlugin
        TCPlugin = TRUE
    end function

    function GetName
        GetName = StName
    end function

    function GetVer
        GetVer = StVer
    end function

    function Get_CanChangeWidth
        Get_CanChangeWidth = bCanChangeWidth
    end function

    function Get_CanChangeHeight
        Get_CanChangeHeight = bCanChangeHeight
    end function

    function Put_CanChangeHeight(b)
        bCanChangeHeight = b
    end function

    function Get_IsOverPos
        Get_IsOverPos = bIsOverPos
    end function

    function Get_IsShowable
        Get_IsShowable = bIsShowable
    end function

    '// Min Heght
    function Get_MinHeight
        Get_MinHeight = nMinHeight
    end function

    '// Min Width
    function Get_MinWidth
        Get_MinWidth = nMinWidth
    end function

    '// Get Heght
    function GetHeight
        GetHeight = nHeight
    end function

    '// Get Width
    function GetWidth
        GetWidth = nWidth
    end function

    '// Set Heght
    function SetHeight(self, Height)
        nHeight = Height
        self.Height = Height
        tabObjectProp.Style.Height = Height
        ListView1.Style.Height = Height - 41
    end function

    '// Set Width
    function SetWidth(self, Width)
        nWidth = Width
        self.Width = Width
        ListView1.Style.Width = Width
        tabObjectProp.Style.Width = Width
    end function

    '// MoveTo
    function MoveTo(self, Left, Top)
        self.style.Left = Left
        self.style.Top = Top
    end function

    '// Hide all Scriptlet's elements
    function Hide(self)
        self.style.display = "none"
    end function

    '// Show all Scriptlet's elements
    function Show(self)
        self.style.display = ""
    end function

'/////////////////////////////////////////////////
    '// ShowMatrixInfo
    function ShowMatrixInfo(GrID)
        LastNodeID = GrID
        LastNodeSubID = ""
        LastNodeName = ""
        call MatrixInfo(GrID)
    end function

    '// ShowVertexInfo
    function ShowVertexInfo(GrID, VxID)
        LastNodeID = GrID
        LastNodeSubID = VxID
        LastNodeName = ""
        call VertexInfo(GrID, VxID)
    end function

    '// ShowGraphicInfo
    function ShowGraphicInfo(GrID)
        LastNodeID = GrID
        LastNodeSubID = ""
        LastNodeName = ""
        call GraphicInfo(GrID)
    end function

    '// ShowRootInfo
    function ShowRootInfo(NodeID,  NodeSubID)
        LastNodeID = NodeID
        LastNodeSubID = NodeSubID
        LastNodeName = ""
        call RootInfo(NodeID,  NodeSubID)
    end function

    '// ShowUCSInfo
    function ShowUCSInfo
        LastNodeID = ""
        LastNodeSubID = ""
        LastNodeName = "UCS"
        call UCSInfo
    end function

    '// ObjectExist
    function ObjectExist(NodeName, NodeID)
        ObjectExist = ObjectExistImpl(NodeName, NodeID)
    end function

    '// ShowObjectInfo
    function ShowObjectInfo(NodeName, NodeID, SubID)
        call ShowObject(NodeName, NodeID, SubID)
    end function

    '// DisplayObject
    function DisplayObject(NodeName, NodeID, SubID)
        call DisplayObjectImpl(NodeName, NodeID, SubID)
    end function

    '// DigitsAfterDecimal
    function Get_DigitsAfterDecimal
        Get_DigitsAfterDecimal = DIGITSAFTERDECIMAL
    end function

    function Put_DigitsAfterDecimal(n)
        DIGITSAFTERDECIMAL = n
    end function

     '// IsGraphic
    function IsGraphic(ObjectName)
        IsGraphic = false
        if IsEmpty(ObjectName) then exit function
        if ObjectName = "" then exit function

        if  ObjectName<>sVertexName and _
            ObjectName<>sLocalucsName and _
            ObjectName<>sUcsName and _
            ObjectName<>sLayerName and _
            ObjectName<>sBlockName and _
            ObjectName<>sRootName and _
            ObjectName<>sAlltypesName then
         IsGraphic = true
        end if
    end function '// IsGraphic

    function ClearContent
        '// List View Init
        ListView1.ListItems.Clear
        ListView1.ColumnHeaders.Clear
        ListView1.GridLines = false
        ListViewMode = LV_MODE_NONE
        tabObjectProp.Tabs.Clear
        tabObjectProp.Refresh
    end function

end class

Sub window_onload
    sVertexName		= StTC.VERTEX_NAME
    sLocalucsName	= StTC.LOCALUCS_NAME
    sUcsName		= StTC.UCS_NAME
    sLayerName		= StTC.LAYER_NAME
    sBlockName		= StTC.BLOCK_NAME
    sRootName		= StTC.ROOT_NAME
    sAlltypesName	= StTC.ALLTYPES_NAME
    sDataName		= StTC.DATA_NAME

    call InitObjectsBaseControls(0, 10, 300, 200)
End Sub

Sub window_onunload
End Sub

'//////////////// specific Part //////////////////////////
'// Tab's ToolTips
const TT_TAB_GRAPHIC_CHILDS		 = "Graphic's Childs"
const TT_TAB_GRAPHIC_FLAGS		 = "Graphic's Flags"
const TT_TAB_GRAPHIC_BUILDINPROP = "Graphic's Building Properties"
const TT_TAB_GRAPHIC_CUSTOMPROP	 = "Graphic's Custom Properties"
const TT_TAB_MATRIX	= "Matrix (4x4)"
const TT_TAB_ROOT	= "Drawing's Root"
const TT_TAB_VERTEX_UCS	= "Coordinates in the User CS"
const TT_TAB_VERTEX_WCS	= "Coordinates in the Word CS"
const TT_TAB_VERTEX_ICS	= "Coordinates in the Internal CS"
const TT_TAB_VERTEX_FLAGS = "Vertex's Flags"

'// ListView object Modes
const LV_MODE_NONE	= 0
const LV_MODE_BLOCK	= 1
const LV_MODE_GRAPHIC = 2
const LV_MODE_LAYER	= 3
const LV_MODE_MATRIX = 4
const LV_MODE_ROOT	= 5
const LV_MODE_VERTEX = 6

'// ListView object SubModes
const LV_SMODE_GRAPHIC_CHILDS = 0
const LV_SMODE_GRAPHIC_FLAGS = 1
const LV_SMODE_GRAPHIC_DATA_BLTIN	= 2
const LV_SMODE_GRAPHIC_DATA_CUSTOM	= 3

const LV_SMODE_VERTEX_UCS = 0	'// Vertex in WP CS
const LV_SMODE_VERTEX_WCS = 1	'// Vertex in World CS
const LV_SMODE_VERTEX_ICS = 2	'// Vertex in Owner Graphic CS
const LV_SMODE_VERTEX_FLAGS = 3	'// Vertex in Owner Graphic CS

const TAB_KEY_VERTEX_WCS = "World CS"
const TAB_KEY_VERTEX_ICS = "Internal CS"
const TAB_KEY_VERTEX_UCS = "UCS"
const TAB_KEY_VERTEX_FLAGS = "Flags"

Dim ListViewWidth
Dim ListViewMode, ListViewSubMode

dim	sVertexName, sLocalucsName, sUcsName, sLayerName, sBlockName, sRootName, sAlltypesName, sDataName

'// Specific LayOut constants
const TabsHeight	= 24
const TabViewHeight = 178 '//150 + TabsHeight

'// Numeric constants
const ZEROEQ = 10E-10
dim DIGITSAFTERDECIMAL
DIGITSAFTERDECIMAL = 10
dim bInitPrecision
bInitPrecision = false

'// Root Statistics
dim nGraphicsCount, nVerticesCount
nGraphicsCount = 0
nVerticesCount = 0

function ParmZero(n)
    if abs(n) < ZEROEQ then
        ParmZero  = 0
    else
        ParmZero  = n
    end if
end function

function FormatCStr(n)
    n = ParmZero(n)
    if (n <> 0) and (abs(n) <> 1) then
        n = FormatNumber(n, DIGITSAFTERDECIMAL, true)
    end if
    FormatCStr = n
end function

function IsNumericAndMsgError(n)
    IsNumericAndMsgError = true
    if (not IsNumeric(n)) then
        'MsgBox n + " - Value can be numeric", , " Warning"
        MsgBox "Value should be numeric", , " Warning"
        IsNumericAndMsgError = false
    end if
end function

'// - InitObjectsBaseControls -
'// Init ObjectsBase Controls: ListView, Tabs
sub InitObjectsBaseControls(nLeft, nTop, nWidth, nHeght)
    tabObjectProp.Style.LEFT = nLeft
    tabObjectProp.Style.width =  nWidth - 2
    tabObjectProp.Style.Top	   = nTop
    tabObjectProp.Style.Height = TabViewHeight
    tabObjectProp.Font = "Verdana, Arial, Helvetica"
    tabObjectProp.Font.Size = 8
    tabObjectProp.Tabs.Clear
    tabObjectProp.Tabs.Add ,"", ""

    ListView1.Style.Top	= nTop + TabsHeight
    ListView1.Style.Height = tabObjectProp.ClientHeight  - TabsHeight
    ListView1.Style.Left = tabObjectProp.ClientLeft + 1
    ListViewWidth = tabObjectProp.ClientWidth - 1
    ListView1.Style.Width = ListViewWidth
    ListView1.Font = "Verdana, Arial, Helvetica"
    ListView1.Font.Size = 8
end sub '// InitObjectsBaseControls

'// - InitPropView -
'// Init Propertes View controls: ListView, Tabs
sub InitPropView(ViewMode)

    tabObjectProp.Tabs.Clear
    tabObjectProp.Refresh
    ListView1.ColumnHeaders.Clear

    select case ViewMode
        case LV_MODE_NONE
            '// Init Tabs
            tabObjectProp.Tabs.Add ,"", ""

            '// Init ListView
            ListView1.GridLines = false

        case LV_MODE_BLOCK

        case LV_MODE_GRAPHIC
            '// Init Tabs
            dim t
            set t = tabObjectProp.Tabs.Add( ,"Childs", "Childs" )
            t.ToolTipText = TT_TAB_GRAPHIC_CHILDS
            set t = tabObjectProp.Tabs.Add( ,"Flags", "Flags" )
            t.ToolTipText = TT_TAB_GRAPHIC_FLAGS
            set t = tabObjectProp.Tabs.Add( ,"Properties", "Properties" )
            t.ToolTipText = TT_TAB_GRAPHIC_BUILDINPROP
            set t = tabObjectProp.Tabs.Add( ,"Custom", "Data")
            t.ToolTipText = TT_TAB_GRAPHIC_CUSTOMPROP

            '// Init ListView
            ListView1.ColumnHeaders.Add  1, ,"Field", (ListViewWidth / 2)-3
            ListView1.ColumnHeaders.Add 2, ,"Value", (ListViewWidth / 2)-3
            ListView1.GridLines = false

        case LV_MODE_LAYER

        case LV_MODE_MATRIX
            '// Init Tabs
            set t = tabObjectProp.Tabs.Add( ,"Matrix", "Matrix" )
            t.ToolTipText = TT_TAB_MATRIX

            Dim Width1, Width2
            Width1 = 25
            Width2 = ((ListViewWidth - Width1)/4)-2
            '// Fill ListView
            ListView1.ColumnHeaders.Add 1, ,"\"	, Width1
            ListView1.ColumnHeaders.Add 2, ,"j 0", Width2
            ListView1.ColumnHeaders.Add 3, ,"j 1", Width2
            ListView1.ColumnHeaders.Add 4, ,"j 2", Width2
            ListView1.ColumnHeaders.Add 5, ,"j 3", Width2
            ListView1.GridLines = true

        case LV_MODE_ROOT
            '// Init Tabs
            set t = tabObjectProp.Tabs.Add( ,"Root", "Root" )
            t.ToolTipText = TT_TAB_ROOT
            '// Fill ListView
            ListView1.ColumnHeaders.Add  1, ,"Field", (ListViewWidth / 2)-3
            ListView1.ColumnHeaders.Add 2, ,"Value", (ListViewWidth / 2)-3
            ListView1.GridLines = false

        case LV_MODE_VERTEX

            if StTC.objApp.ActiveDrawing.Properties("TileMode") = 0 then '// PAPER_SPACE
                set t = tabObjectProp.Tabs.Add( ,TAB_KEY_VERTEX_WCS, TAB_KEY_VERTEX_WCS)
                t.ToolTipText = TT_TAB_VERTEX_WCS
            else
                set t = tabObjectProp.Tabs.Add( ,TAB_KEY_VERTEX_UCS, TAB_KEY_VERTEX_UCS)
                t.ToolTipText = TT_TAB_VERTEX_UCS
                set t = tabObjectProp.Tabs.Add( ,TAB_KEY_VERTEX_WCS, TAB_KEY_VERTEX_WCS)
                t.ToolTipText = TT_TAB_VERTEX_WCS
                set t = tabObjectProp.Tabs.Add( ,TAB_KEY_VERTEX_ICS, TAB_KEY_VERTEX_ICS)
                t.ToolTipText = TT_TAB_VERTEX_ICS
            end if

            set t = tabObjectProp.Tabs.Add( ,TAB_KEY_VERTEX_FLAGS, TAB_KEY_VERTEX_FLAGS)
            t.ToolTipText = TT_TAB_VERTEX_FLAGS

            '// Fill ListView
            ListView1.ColumnHeaders.Add  1, ,"Field", (ListViewWidth / 2)-3
            ListView1.ColumnHeaders.Add 2, ,"Value", (ListViewWidth / 2)-3
            ListView1.GridLines = false
     end select

    ListViewMode = ViewMode
    ListViewSubMode	= 0
end sub'// InitPropView

'// - GraphicInfo -
'// Show Graphic Info
Sub GraphicInfo(GrID)

    ListView1.ListItems.Clear
    if (ListViewMode <> LV_MODE_GRAPHIC) then
        call InitPropView(LV_MODE_GRAPHIC)
    end if

    '// Check Graphic
    if not StTC.GraphicExist(GrID) then
        alert ("Graphic not found")
        exit sub
    end if

    dim Gr, Grs,item
    set Grs = StTC.GraphicsCollection
    set Gr = Grs.GraphicFromID(GrID)

    dim val, Name
    dim Pr, Prs

    select case ListViewSubMode
        case LV_SMODE_GRAPHIC_CHILDS

            '// Vertices
            set item = ListView1.ListItems.Add(1, ,"Vertices")
            item.SubItems(1) = CStr(Gr.Vertices.Count)

            '// Children
            set item = ListView1.ListItems.Add(1, ,"Graphics")
            item.SubItems(1) = CStr(Gr.Graphics.Count)

            '// Name
            set item = ListView1.ListItems.Add(1, ,"Name")
            item.SubItems(1) = Gr.Name

        case LV_SMODE_GRAPHIC_FLAGS

            set item = ListView1.ListItems.Add(1, ,"Closed")
            item.SubItems(1) = CStr(Gr.Closed)

            set item = ListView1.ListItems.Add(1, ,"Deleted")
            item.SubItems(1) = CStr(Gr.Deleted)

            set item = ListView1.ListItems.Add(1, ,"Editable")

            item.SubItems(1) = CStr(Gr.Editable)

            set item = ListView1.ListItems.Add(1, ,"Unbounded")
            item.SubItems(1) = CStr(Gr.Unbounded)

            set item = ListView1.ListItems.Add(1, ,"Visible")
            item.SubItems(1) = CStr(Gr.Visible)

            set item = ListView1.ListItems.Add(1, ,"Cosmetic")
            item.SubItems(1) = CStr(Gr.Cosmetic)

        case LV_SMODE_GRAPHIC_DATA_BLTIN

            set Prs = Gr.Properties
            for each Pr in Prs

                On Error Resume Next
                Err.Clear
                    val = Pr.Value
                if Err.Number = 0 then
                    if Pr.BuiltIn then
                        Name = Pr.Name
                        set item = ListView1.ListItems.Add(1, ,Pr.Name)
                        item.SubItems(1) = CStr(Pr.Value)
                    end if
                end if
            Next
            Set prs = Nothing

        case LV_SMODE_GRAPHIC_DATA_CUSTOM

            set Prs = Gr.Properties
            for each Pr in Prs

                On Error Resume Next
                Err.Clear
                    val = Pr.Value
                if Err.Number = 0 then
                    if not Pr.BuiltIn then
                        Name = Pr.Name
                        set item = ListView1.ListItems.Add(1, ,Pr.Name)
                        item.SubItems(1) = CStr(Pr.Value)
                    end if
                end if
            Next
            Set prs = Nothing

     end select

    ListView1.SelectedItem = item

    Set Gr = Nothing
    Set Grs = Nothing
end sub '// GraphicInfo

'// - RootInfo -
'// Show Root Info
Sub RootInfo(NodeID,  NodeSubID)
    ListView1.ListItems.Clear
    if (ListViewMode <> LV_MODE_ROOT) then
        call InitPropView(LV_MODE_ROOT)
    end if

    Dim item, Grs, ActDrawing
    Set ActDrawing = StTC.ActiveDrawing
    Set Grs = ActDrawing.Selection

    '// Children
    set item = ListView1.ListItems.Add(1, ,"Vertices")
    item.SubItems(1) = CStr(NodeSubID)

    set item = ListView1.ListItems.Add(1, ,"Graphics")
    item.SubItems(1) = CStr(NodeID)

    ListView1.SelectedItem = item

    Set ActDrawing = Nothing
    Set Grs = Nothing
end sub '// RootInfo

'// - MatrixInfo -
'// Show Matrix Info
Sub MatrixInfo(GrID)
    Dim Item, Gr, Grs, m ,i , j

    ListView1.ListItems.Clear
    if (ListViewMode <> LV_MODE_MATRIX) then
        call InitPropView(LV_MODE_MATRIX)
    end if

    '// Check Graphic
    if not StTC.GraphicExist(GrID) then
        alert ("Graphic not found")
        exit sub
    end if

    Set Grs = StTC.GraphicsCollection
    set Gr = Grs.GraphicFromID(GrID)
    set m = Gr.UCS

    Dim Entry

    For i = 0 To 3
        set item = ListView1.ListItems.Add(1, ,"i " + CStr(3 - i))
        For j = 0 To 3
            item.SubItems(j + 1) = FormatCStr(m.GetEntry(3 - i, j))
        Next
    Next
    ListView1.SelectedItem = item

    Set Gr = Nothing
    Set Grs = Nothing
    Set m = Nothing
end sub '// MatrixInfo

'// - UCSInfo -
'// Show UCS Matrix Info
Sub UCSInfo()
    Dim ActDrawing, Item, m ,i , j

    ListView1.ListItems.Clear
    if (ListViewMode <> LV_MODE_MATRIX) then
        call InitPropView(LV_MODE_MATRIX)
    end if

    set ActDrawing = StTC.ActiveDrawing
    set m = ActDrawing.UCS

    Dim Entry

    For i = 0 To 3
        set item = ListView1.ListItems.Add(1, ,"i " + CStr(3 - i))
        For j = 0 To 3
            item.SubItems(j + 1) = FormatCStr(m.GetEntry(3 - i, j))
        Next
    Next
    ListView1.SelectedItem = item

    Set ActDrawing = Nothing
    Set m = Nothing
end sub '// MatrixInfo

'// Matrix routine
'// Matrix(double): m(3,3)
'// Point p(3)
sub MatrixInvert(m, mInv)
    dim i, j

    '// Build Invert Matrix
    '// Invert 3*3 left corner
    For i = 0 To 2
        For j = 0 To 2
            mInv(i, j) = m(j, i)
        Next
    Next

    mInv(0,3) = - (m(0,3)*m(0,0) + m(1,3)*m(1,0) + m(2,3)*m(2,0))
    mInv(1,3) = - (m(0,3)*m(0,1) + m(1,3)*m(1,1) + m(2,3)*m(2,1))
    mInv(2,3) = - (m(0,3)*m(0,2) + m(1,3)*m(1,2) + m(2,3)*m(2,2))
end sub

sub MatrixFromTC(m, mTC)
    dim i, j

    '// Copy TCW matrix to VB matrix
    with mTC
    For i = 0 To 3
        For j = 0 To 3
            m(i, j) = .GetEntry(i, j)
        Next
    Next
    end with
end sub

sub PointTransform(vTo, vFrom, mTrans)
    vTo(0) = mTrans(0,0) * vFrom(0) + mTrans(0,1) * vFrom(1) + mTrans(0,2) * vFrom(2) + mTrans(0,3)
    vTo(1) = mTrans(1,0) * vFrom(0) + mTrans(1,1) * vFrom(1) + mTrans(1,2) * vFrom(2) + mTrans(1,3)
    vTo(2) = mTrans(2,0) * vFrom(0) + mTrans(2,1) * vFrom(1) + mTrans(2,2) * vFrom(2) + mTrans(2,3)
end sub

'// - VertexInfo -
'// Show Vertex Info
sub VertexInfo(GrID, VertNum)

    ListView1.ListItems.Clear
    if (ListViewMode <> LV_MODE_VERTEX) then
        call InitPropView(LV_MODE_VERTEX)
    end if

    '// Check Graphic
    if not StTC.GraphicExist(GrID) then
        alert ("Graphic not found")
        exit sub
    end if

    dim Item, Gr, Grs, v

    set Grs = StTC.GraphicsCollection
    set Gr = Grs.GraphicFromID(GrID)

    Gr.Vertices.UseWorldCS = true
    set v = Gr.Vertices.Item(VertNum)

    select case tabObjectProp.SelectedItem.Key

            case TAB_KEY_VERTEX_WCS
                Gr.Vertices.UseWorldCS = true

                '// Fill List View
                Set item = ListView1.ListItems.Add(1, ,"Z")
                item.SubItems(1) = FormatCStr(v.z)
                Set item = ListView1.ListItems.Add(1, ,"Y")
                item.SubItems(1) = FormatCStr(v.y)
                Set item = ListView1.ListItems.Add(1, ,"X")
                item.SubItems(1) = FormatCStr(v.x)

            case TAB_KEY_VERTEX_ICS
                Gr.Vertices.UseWorldCS = false
                '// Fill List View
                Set item = ListView1.ListItems.Add(1, ,"Z")
                item.SubItems(1) = FormatCStr(v.z)
                Set item = ListView1.ListItems.Add(1, ,"Y")
                item.SubItems(1) = FormatCStr(v.y)
                Set item = ListView1.ListItems.Add(1, ,"X")
                item.SubItems(1) = FormatCStr(v.x)

            case TAB_KEY_VERTEX_UCS
                dim xRes, yRes, zRes	'// Result Vertex coord value
                '// Transfom vertex to current Workplane
                Dim m(3, 3), mInv(3, 3), vTo(3), vFrom(3)
                vFrom(0) = v.x
                vFrom(1) = v.y
                vFrom(2) = v.z

                call MatrixFromTC(m, StTC.ActiveDrawing.UCS)
                call MatrixInvert(m, mInv)
                call PointTransform(vTo, vFrom, mInv)
                xRes = vTo(0)
                yRes = vTo(1)
                zRes = vTo(2)

                '// Fill List View
                Set item = ListView1.ListItems.Add(1, ,"Z")
                item.SubItems(1) = FormatCStr(zRes)
                Set item = ListView1.ListItems.Add(1, ,"Y")
                item.SubItems(1) = FormatCStr(yRes)
                Set item = ListView1.ListItems.Add(1, ,"X")
                item.SubItems(1) = FormatCStr(xRes)

            case TAB_KEY_VERTEX_FLAGS
                '// Calculated
                set item = ListView1.ListItems.Add(1, ,"Calculated")
                item.SubItems(1) = CStr(v.Calculated)
                '// Editable
                set item = ListView1.ListItems.Add(1, ,"Editable")
                item.SubItems(1) = CStr(v.Editable)
                '// Linkable
                set item = ListView1.ListItems.Add(1, ,"Linkable")
                item.SubItems(1) = CStr(v.Linkable)
                '// PenDown
                set item = ListView1.ListItems.Add(1, ,"PenDown")
                item.SubItems(1) = CStr(v.PenDown)
                '// Selectable
                set item = ListView1.ListItems.Add(1, ,"Selectable")
                item.SubItems(1) = CStr(v.Selectable)
                '// Snappable
                set item = ListView1.ListItems.Add(1, ,"Snappable")
                item.SubItems(1) = CStr(v.Snappable)
    end select

    ListView1.SelectedItem = item

    Set Gr = Nothing
    Set Grs = Nothing
    Set v = Nothing
end sub '// VertexInfo

'/////// Vertex positoin Mark Routine ///////

dim GrMark, bShowMark
bShowMark = false
const ShowMarkTime = 100 '//(msec)

'// DeleteMark
sub DeleteMark
    if not bShowMark then
        exit sub
    end if

    bShowMark = false
    '//GrMark.Draw objApp.ActiveDrawing.Views.Item(0)
    StTC.objApp.ActiveDrawing.Graphics.Remove(GrMark.Index)
    GrMark.Delete
    set GrMark = nothing
end sub '// DeleteMark

sub ShowMark(x, y, z, InfoStr)
    if bShowMark then
        exit sub
    end if

    bShowMark = true

    dim Grs, View
    '// Init TCW vars
    set Grs = StTC.GraphicsCollection
    set View = StTC.View

    '// Set Mark
    'set GrMark = Grs.Add(11, "TCW30POINT")
    'GrMark.Vertices.Add x,y,z
    'GrMark.Properties("$POINTTYPE") = 2
    'GrMark.Properties("$POINTSIZE") = 0.15
    'GrMark.Properties("PenColor") = 65280'&HFF00

    dim GrTmp, GrText,GrsTmp
    set GrMark = Grs.Add(11)
    GrMark.Vertices.Add x,y,z
    GrMark.Vertices.Add x,y,z
    GrMark.Properties("PenWidth") = 0.1
    GrMark.Properties("PenColor") = 65280'&HFF00

    dim Ext, v1, v2
    set Ext = GrMark.CalcBoundingBox
    set v1 = Ext.Max
    set v2 = Ext.Min

    dim h , l
    h = abs(v1.y - v2.y)
    l = abs(v1.x - v2.x)

    select case len(InfoStr)
        case 1
            l = l - l * 2/3
        case 2
            l = l - l * 3/4
        case 3
            l = l - l
    end select

    call GrMark.Graphics.AddText(InfoStr, v2.x + l,v1.y,v1.z, h)

    set Ext = nothing
    set v1 = nothing
    set v2 = nothing

    GrMark.Draw View

    '// Release TCW vars
    set Grs = nothing
    set View = nothing

    window.setTimeOut "DeleteMark", ShowMarkTime
end sub '// ShowMark

sub ShowVertex(GrID, VertNum)

    '// Check Graphic
    if not StTC.GraphicExist(GrID) then
        alert ("Graphic not found")
        exit sub
    end if

    Dim g, v
    set g = StTC.objApp.ActiveDrawing.Graphics.GraphicFromID(GrID)
    g.Vertices.UseWorldCS = true
    set v = g.Vertices.Item(VertNum)

    call ShowMark(v.x, v.y, v.z, CStr(VertNum) + 1)

    set g = nothing
    set v = nothing
end sub '// ShowVertex

'// ObjectExistImpl
function ObjectExistImpl(NodeName, NodeID)

    Select Case NodeName
        Case sLocalucsName,sVertexName,sDataName
            ObjectExistImpl = StTC.GraphicExist(NodeID)

        Case sRootName,sUcsName
            ObjectExistImpl = true

        Case sBlockName  '//	Block Action
            ObjectExistImpl = true
               'call BlockInfo

        Case Else '// Any Graphic Action
            ObjectExistImpl = StTC.GraphicExist(NodeID)
     End Select
end function '// ObjectExistImpl

'dim LastSelNodeIndex
dim LastNodeName, LastNodeID, LastNodeSubID
'// ShowObject
sub ShowObject(NodeName, NodeID, NodeSubID)

'	LastSelNodeIndex = node.Index
    LastNodeName = NodeName
    LastNodeID = NodeID
    LastNodeSubID = NodeSubID

    Select Case NodeName
        Case sLocalucsName    '//	Matrix Action
               call MatrixInfo(NodeID)

        Case sVertexName    '//	Vertex Action
               call VertexInfo(NodeID,  NodeSubID)

        Case sDataName
            call GraphicInfo(NodeID)

        Case sRootName  '//	Root Action
               call RootInfo(NodeID,  NodeSubID)

        Case sUcsName  '//	UCS Action
               call UCSInfo

        Case sBlockName  '//	Block Action
               'call BlockInfo

        Case Else '// Any Graphic Action
            call GraphicInfo(NodeID)
     End Select

     'UpdateToolBarUI
end sub 'ShowObject

'// DisplayObjectImpl
sub DisplayObjectImpl(NodeName, NodeID, NodeSubID)
    dim Gr, View
    LastNodeName = NodeName
    LastNodeID = NodeID
    LastNodeSubID = NodeSubID

    select case NodeName

        case sVertexName    '//	Vertex Action
               call VertexInfo(NodeID,  NodeSubID)
               call ShowVertex(NodeID,  NodeSubID)

        Case sLocalucsName    '//	Matrix Action
        Case sVertexName    '//	Vertex Action
        Case sDataName
        Case sBlockName
        Case sRootName  '//	Root Action

        Case Else '// Any Graphic Action
            '// Init TCW vars
            Set View = StTC.View

            if StTC.objApp.ActiveDrawing.Selection.Count > 0 then
                dim sel
                set sel = StTC.objApp.ActiveDrawing.Selection

                if sel.Count > 20 then
                    sel.Unselect
                    dim v
                    for each v in StTC.ActiveDrawing.Views
                        v.Refresh
                    next
                else
                    for each Gr in sel
                        Gr.Unselect
                        Gr.Draw View
                    next
                end if

                set sel = nothing
            end if

            '// Check Graphic
            if not StTC.GraphicExist(NodeID) then
                alert ("Graphic not found")
                exit sub
            end if

            set Gr = StTC.objApp.ActiveDrawing.Graphics.GraphicFromID(NodeID)
            Gr.Select
            Gr.Draw View
            GraphicInfo(NodeID)

            '// Release TCW vars
            Set Gr = Nothing
            Set View = Nothing
     end select
end sub

function CheckObject(ObjectName, ObjectID)
    CheckObject = true

    '// Check Object
    if not ObjectExistImpl(ObjectName, ObjectID) then
        dim sMessage, iRes
        sMessage = "Object: " + ObjectName + " not found." + vbCrLf
        sMessage = sMessage + "Drawing was changed." + vbCrLf
        iRes = MsgBox(sMessage, vbInformation, "Warning")
        CheckObject = false
        exit function
     end if
end function

-->
</SCRIPT>

<SCRIPT ID=clientEventHandlersVBS LANGUAGE=vbscript>
<!--

Sub tabObjectProp_Click
    ListViewSubMode = tabObjectProp.SelectedItem.Index - 1

    '// Check Object
    if not CheckObject(LastNodeName, LastNodeID) then exit sub

    call ShowObject(LastNodeName, LastNodeID, LastNodeSubID)
end sub

Sub ListView1_DblClick

    if ListView1.ListItems.Count = 0 then
        exit sub
    end if

    '// Check Object
    if not CheckObject(LastNodeName, LastNodeID) then exit sub

    dim PropName, PropVal, PropValNew
    PropName = ListView1.SelectedItem.Text
    PropVal = ListView1.SelectedItem.ListSubItems.Item(1).Text

    'dim Gr

    select case ListViewMode
        case LV_MODE_NONE
        case LV_MODE_BLOCK
        case LV_MODE_LAYER
        case LV_MODE_ROOT

        case LV_MODE_GRAPHIC
            dim Gr
            if (ListViewSubMode = LV_SMODE_GRAPHIC_FLAGS OR _
                ListViewSubMode = LV_SMODE_GRAPHIC_DATA_BLTIN OR _
                ListViewSubMode = LV_SMODE_GRAPHIC_DATA_CUSTOM) then

                PropValNew = Inputbox("Enter value for " + PropName + " parameter",,PropVal)
                if PropValNew = "" then exit sub
                set Gr = StTC.GraphicsCollection.GraphicFromID(LastNodeID)
            else
                exit sub
            end if

            select case ListViewSubMode
                case LV_SMODE_GRAPHIC_FLAGS
                    if (PropValNew <> "True") AND (PropValNew <> "False") then
                     call MsgBox("'"+ PropValNew + "' - invalid value" + vbCrLf + "Enter True or False", , " Warning")
                     exit sub
                    end if

                    select case PropName
                        case "Closed"
                            Gr.Closed = PropValNew

                        case "Editable"
                            Gr.Editable = PropValNew

                        case "Deleted"
                            Gr.Deleted = PropValNew

                        case "Unbounded"
                            Gr.Unbounded = PropValNew

                        case "Visible"
                            Gr.Visible = PropValNew

                        case "Cosmetic"
                            Gr.Cosmetic = PropValNew

                    end select

                case LV_SMODE_GRAPHIC_DATA_BLTIN, LV_SMODE_GRAPHIC_DATA_CUSTOM
                    if IsNumeric(PropValNew) then
                        Gr.Properties(PropName) = Cdbl(PropValNew)
                    else
                        Gr.Properties(PropName) = PropValNew
                    end if

            end select '// ListViewSubMode

            if Gr.Properties("Selected") = 1 then Gr.Select
            set Gr = nothing

        case LV_MODE_VERTEX
            PropValNew = Inputbox("Enter value for " + PropName + " parameter",,PropVal)

            if PropValNew = "" then exit sub
            Dim m(3,3), mInv(3,3), mUCS(3,3), vTo(3), vFrom(3)
            dim v
            set Gr = StTC.GraphicsCollection.GraphicFromID(LastNodeID)
            set v = Gr.Vertices.Item(LastNodeSubID)

            select case ListViewSubMode
                case LV_SMODE_VERTEX_UCS

                    if not IsNumericAndMsgError(PropValNew) then
                     Set v = Nothing
                     exit sub
                    end if

                    L = CDbl(PropValNew)

                    '// Go from UCS to Local UCS

                    vFrom(0) = v.x
                    vFrom(1) = v.y
                    vFrom(2) = v.z

                    '// Set new value
                    select case PropName
                        case "X"
                            vFrom(0) = L

                        case "Y"
                            vFrom(1) = L

                        case "Z"
                            vFrom(2) = L
                    end select

                    '// Transform new point from UCS to WCS
                    call MatrixFromTC(mUCS, StTC.ActiveDrawing.UCS)
                    call PointTransform(vTo, vFrom, mUCS)
                    vFrom(0) = vTo(0)
                    vFrom(1) = vTo(1)
                    vFrom(2) = vTo(2)

                    '// Transform new point from WCS to Internal CS
                    '// Find and Invert Local UCS
                    call MatrixFromTC(m, StTC.GraphicsCollection.GraphicFromID(LastNodeID).UCS)
                    call MatrixInvert(m, mInv)
                    call PointTransform(vTo, vFrom, mInv)

                    select case PropName
                        case "X"
                            v.x = vTo(0)

                        case "Y"
                            v.y = vTo(1)

                        case "Z"
                            v.z = vTo(2)
                    end select

                case LV_SMODE_VERTEX_WCS

                    if not IsNumericAndMsgError(PropValNew) then
                     Set v = Nothing
                     exit sub
                    end if
                    L = CDbl(PropValNew)

                    '// Go from WCS to Local UCS
                    vFrom(0) = v.x
                    vFrom(1) = v.y
                    vFrom(2) = v.z

                    '// Set new value
                    select case PropName
                        case "X"
                            vFrom(0) = L

                        case "Y"
                            vFrom(1) = L

                        case "Z"
                            vFrom(2) = L
                    end select

                    '// Find and Invert Local UCS
                    call MatrixFromTC(m, StTC.GraphicsCollection.GraphicFromID(LastNodeID).UCS)
                    call MatrixInvert(m, mInv)
                    '// Transform new point to Internal CS
                    call PointTransform(vTo, vFrom, mInv)

                    select case PropName
                        case "X"
                            v.x = vTo(0)

                        case "Y"
                            v.y = vTo(1)

                        case "Z"
                            v.z = vTo(2)
                    end select

                case LV_SMODE_VERTEX_ICS

                    if not IsNumericAndMsgError(PropValNew) then
                     Set v = Nothing
                     exit sub
                    end if
                    L = CDbl(PropValNew)

                    select case PropName
                        case "X"
                            v.x = L
                        case "Y"
                            v.y = L
                        case "Z"
                            v.z = L
                    end select

                case LV_SMODE_VERTEX_FLAGS
                    if (PropValNew <> "True") AND (PropValNew <> "False") then
                     call MsgBox("'"+ PropValNew + "' - invalid value" + vbCrLf + "Enter True or False", , " Warning")
                     Set v = Nothing
                     exit sub
                    end if

                    select case PropName
                        case "Calculated"
                            v.Calculated = PropValNew

                        case "Editable"
                            v.Editable = PropValNew

                        case "Linkable"
                            v.Linkable = PropValNew

                        case "PenDown"
                            v.PenDown = PropValNew

                        case "Selectable"
                            v.Selectable = PropValNew
                        case "Snappable"
                            v.Snappable = PropValNew
                    end select

            end select '// ListViewSubMode
            if Gr.Properties("Selected") = 1 then Gr.Select
            set Gr = nothing

        case LV_MODE_MATRIX
            '// TODO
     end select

    call ShowObject(LastNodeName, LastNodeID, LastNodeSubID)
    StTC.View.Refresh

End Sub

Sub ListView1_Click

    if ListView1.ListItems.Count = 0 then
        exit sub
    end if

    window.external.raiseEvent "ListView_Click", ListView1.SelectedItem.ListSubItems.Item(1).Text

End Sub

-->
</SCRIPT>

<BODY bgcolor=silver style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small">

<!-- StTC -->
<OBJECT height=0 id=StTC name=StTC
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 104"
type=text/x-scriptlet width=0><PARAM NAME="Scrollbar" VALUE="0"><PARAM NAME="URL" VALUE="StTC.htm"></OBJECT>

<!------------------ ObjectBase Controls -------------------------->
<P style="BACKGROUND-COLOR: silver; BORDER-BOTTOM-COLOR: silver; FONT-WEIGHT: normal; TEXT-ALIGN: left">&nbsp;

<!-- ListView1 -->
<OBJECT classid=clsid:BDD1F04B-858B-11D1-B16A-00C0F0283628 id=ListView1
style="HEIGHT: 151px; LEFT: 3px; POSITION: absolute; TOP: 18px; WIDTH: 247px; Z-INDEX: 105"
VIEWASTEXT><PARAM NAME="_ExtentX" VALUE="5228"><PARAM NAME="_ExtentY" VALUE="3196"><PARAM NAME="SortKey" VALUE="0"><PARAM NAME="View" VALUE="3"><PARAM NAME="Arrange" VALUE="2"><PARAM NAME="LabelEdit" VALUE="0"><PARAM NAME="SortOrder" VALUE="0"><PARAM NAME="Sorted" VALUE="0"><PARAM NAME="MultiSelect" VALUE="0"><PARAM NAME="LabelWrap" VALUE="0"><PARAM NAME="HideSelection" VALUE="-1"><PARAM NAME="HideColumnHeaders" VALUE="0"><PARAM NAME="OLEDragMode" VALUE="0"><PARAM NAME="OLEDropMode" VALUE="0"><PARAM NAME="AllowReorder" VALUE="-1"><PARAM NAME="Checkboxes" VALUE="0"><PARAM NAME="FlatScrollBar" VALUE="0"><PARAM NAME="FullRowSelect" VALUE="-1"><PARAM NAME="GridLines" VALUE="0"><PARAM NAME="HotTracking" VALUE="-1"><PARAM NAME="HoverSelection" VALUE="-1"><PARAM NAME="PictureAlignment" VALUE="0"><PARAM NAME="TextBackground" VALUE="0"><PARAM NAME="_Version" VALUE="393217"><PARAM NAME="ForeColor" VALUE="-2147483640"><PARAM NAME="BackColor" VALUE="-2147483643"><PARAM NAME="BorderStyle" VALUE="1"><PARAM NAME="Appearance" VALUE="1"><PARAM NAME="MousePointer" VALUE="0"><PARAM NAME="Enabled" VALUE="1"><PARAM NAME="NumItems" VALUE="0"></OBJECT>

<!-- tabObjectProp -->
<OBJECT classid=clsid:1EFB6596-857C-11D1-B16A-00C0F0283628 id=tabObjectProp
style="FONT-FAMILY: sans-serif; FONT-SIZE: xx-small; HEIGHT: 192px; LEFT: 0px; POSITION: absolute; TOP: 0px; WIDTH: 254px; Z-INDEX: 100"><PARAM NAME="_ExtentX" VALUE="5376"><PARAM NAME="_ExtentY" VALUE="4064"><PARAM NAME="TabWidthStyle" VALUE="0"><PARAM NAME="MultiRow" VALUE="0"><PARAM NAME="Style" VALUE="0"><PARAM NAME="ShowTips" VALUE="1"><PARAM NAME="TabFixedWidth" VALUE="0"><PARAM NAME="TabFixedHeight" VALUE="0"><PARAM NAME="HotTracking" VALUE="1"><PARAM NAME="MultiSelect" VALUE="1"><PARAM NAME="Placement" VALUE="0"><PARAM NAME="Separators" VALUE="1"><PARAM NAME="TabMinWidth" VALUE="995"><PARAM NAME="TabStyle" VALUE="0"><PARAM NAME="ImageList" VALUE=""><PARAM NAME="_Version" VALUE="393216"><PARAM NAME="MousePointer" VALUE="0"><PARAM NAME="Enabled" VALUE="1"><PARAM NAME="OLEDropMode" VALUE="0"></OBJECT>
</P>

</BODY>
</HTML>


Examples - Internet Palette Scripts - StTC.htm

StTC.htm

Internet Palette Scripts Example

<HTML>
<HEAD>
<META name=VI60_defaultClientScript content=VBScript>
<META name=StTC content=VBScript>
<TITLE>StTC</TITLE>

<SCRIPT ID=StTC Name=StTC LANGUAGE="VBScript">
option Explicit

Const ObjName = "IMSIGX.Vertex" '// for Pro version
'Const ObjName = "TurboCad.Drawing" '// for Pro and Standard version

'// About
Const StName = "StTC"
Const StVer = 1.0

'// resize Behavior vars
dim bCanChangeWidth, bCanChangeHeight, bIsOverPos, bIsShowable
bCanChangeWidth = FALSE
bCanChangeHeight = FALSE
bIsOverPos = FALSE
bIsShowable = TRUE

const nMinHeight = 0
const nMinWidth  = 0
dim nHeight, nWidth
nHeight = 0
nWidth = 0

dim public_description
set public_description = new Interface
class Interface

    '// TCPlugin
    '// For Scriptlet check
    function TCPlugin
        TCPlugin = TRUE
    end function

    function GetName
        GetName = StName
    end function

    function GetVer
        GetVer = StVer
    end function

    function Get_CanChangeWidth
        Get_CanChangeWidth = bCanChangeWidth
    end function

    function Get_CanChangeHeight
        Get_CanChangeHeight = bCanChangeHeight
    end function

    function Get_IsOverPos
        Get_IsOverPos = bIsOverPos
    end function

    function Get_IsShowable
        Get_IsShowable = bIsShowable
    end function

    '// Min Heght
    function Get_MinHeight
        Get_MinHeight = nMinHeight
    end function

    '// Min Width
    function Get_MinWidth
        Get_MinWidth = nMinWidth
    end function

    '// Get Heght
    function GetHeight
        GetHeight = nHeight
    end function

    '// Get Width
    function GetWidth
        GetWidth = nWidth
    end function

    '// Set Heght
    function SetHeight(self, Height)
        Height = nHeight
    end function

    '// Set Width
    function SetWidth(self, Width)
        nWidth = Width
    end function

    '// MoveTo
    function MoveTo(self, Left, Top)
        self.style.Left = Left
        self.style.Top = Top
    end function

    '// Hide all Scriptlet's elements
    function Hide(self)
        self.style.display = "none"
    end function

    '// Show all Scriptlet's elements
    function Show(self)
        self.style.display = ""
    end function

'///////////////////////////////////////////////////
    '// getActiveDrawing //'
    '// return Active Drawing object
    function get_ObjApp
        set get_ObjApp = objApp
    end function '// getActiveDrawing

    '// getActiveDrawing //'
    '// return Active Drawing object
    function get_ActiveDrawing
        set get_ActiveDrawing = objApp.ActiveDrawing
    end function '// getActiveDrawing

    '// getGraphicsCollection //'
    '// return GraphicsCollection object
    function get_GraphicsCollection
        set get_GraphicsCollection = objApp.ActiveDrawing.Graphics
    end function'// getGraphicsCollection

    '// getSelectGraphicsCollection //'
    '// return getSelectGraphicsCollection object
    function get_SelectGraphicsCollection
        set get_SelectGraphicsCollection = objApp.ActiveDrawing.Selection
    End function'// getSelectGraphicsCollection

    '// getView //'
    '// return View object
    function get_View
        set get_View = objApp.ActiveDrawing.Views.Item(0)
    End function'// getView

    function Get_ALLTYPES_NAME
        Get_ALLTYPES_NAME	= ALLTYPES_NAME
    end function
    function Get_BLOCK_NAME
        Get_BLOCK_NAME	= BLOCK_NAME
    end function
    function Get_DATA_NAME
        Get_DATA_NAME		= DATA_NAME
    end function
    function Get_LAYER_NAME
        Get_LAYER_NAME	= LAYER_NAME
    end function
    function Get_LOCALUCS_NAME
        Get_LOCALUCS_NAME	= LOCALUCS_NAME
    end function
    function Get_ROOT_NAME
        Get_ROOT_NAME		= ROOT_NAME
    end function
    function Get_VERTEX_NAME
        Get_VERTEX_NAME	= VERTEX_NAME
    end function
    function Get_UCS_NAME
        Get_UCS_NAME		= UCS_NAME
    end function

    function IsGraphicName(Name)
        IsGraphicName = IsGraphicNameImpl(Name)
    end function

    function FindNodeName(s)
        FindNodeName = GetNodeName(s)
    end function

    function FindNodeInfoStr(s)
        FindNodeInfoStr = GetNodeInfoStr(s)
    end function

    '// Event routine
    function CreateEvents(Events)
        ConnectEvents(Events)
    end function

    function DeleteEvents()
        DisconnectEvents
    end function

    function Get_EventBeforeExit
        Get_EventBeforeExit = EventBeforeExit
    end function

    function Get_EventDrawingBeforeClose
        Get_EventDrawingBeforeClose = EventDrawingBeforeClose
    end function

    function Get_EventMouseDown
        Get_EventMouseDown = EventMouseDown
    end function

    function Get_EventSelectionChange
        Get_EventSelectionChange = EventSelectionChange
    end function

    function Get_EventStartNewTool
        Get_EventStartNewTool = EventStartNewTool
    end function

    function ReleaseEvent(EventID)
        if EventsFlag - EventID >= 0 then EventsFlag = EventsFlag - EventID
    end function

    function Get_EventsFlag
        Get_EventsFlag = EventsFlag
    end function

    function GraphicIsEditable(g)
        GraphicIsEditable = GraphicIsEditableImpl(g)
    end function

    function GraphicCanDeleteVertices(g)
        GraphicCanDeleteVertices = GraphicCanDeleteVerticesImpl(g)
    end function

    function GraphicCanDeleteChildrens(g)
        GraphicCanDeleteChildrens = GraphicCanDeleteChildrensImpl(g)
    end function

    '// Find Graphic From ID in Active Drawing
    function GraphicExist(GrID)
        GraphicExist = true

        On Error Resume Next
        Err.Clear

        objApp.ActiveDrawing.Graphics.GraphicFromID(GrID)

        if Err.Number <> 0 then
            GraphicExist = false
        end if
    end function

end class

dim bExitApp
bExitApp = false

'// Event routine
const EventBeforeExit = 1
const EventDrawingBeforeClose = 32
const EventMouseDown = 1024
const EventSelectionChange = 32768
const EventStartNewTool = 262144
dim bRaiseSelectionChangeevent
bRaiseSelectionChangeevent = FALSE

dim idEvent ,TCEvent
dim EventsFlag
EventsFlag = 0
idEvent = -1
class TCEvents
    '// Event ID = 1
    public function BeforeExit(WhichApp, bCancel)
        bExitApp = true
        window.external.raiseEvent "EventBeforeExit", 1
    end function

    '// Event ID = 32
    public function DrawingBeforeClose(WhichApp, bCancel)
        window.external.raiseEvent "EventDrawingBeforeClose", 32
    end function

    '// MouseDown TC Event (ID = 1024)
    public function MouseDown(WhichDrawing, WhichView, WhichWindow, Button, Shift, X, Y, Cancel)
        window.external.raiseEvent "EventMouseDown", 1024
    end function

    '// Event ID = 32768
    public function SelectionChange(WhichDrawing, WhichView, WhichWindow, Selection)

        if (EventsFlag AND 32768) then  exit function
        EventsFlag = EventsFlag + 32768

        window.external.raiseEvent "EventSelectionChange", 32768
    end function

    '// Event ID = 262144
    public function StartNewTool(Tool)
        window.external.raiseEvent "EventStartNewTool", 262144
    end function

end class

function ConnectEvents(Events)
    set TCEvent = new TCEvents
    idEvent = objApp.ConnectEvents(TCEvent, Events)
end function

function DisconnectEvents()
    if (idEvent > -1) then
        objApp.DisconnectEvents(idEvent)
        idEvent = -1
    end if
    if IsObject(TCEvent) then
        Set TCEvent	= nothing
    end if
end function

Sub window_onload
    if not(openInTC) then
        Exit sub
    end if

    if not(isTCVersionOk) then
        Exit sub
    end if
End Sub

Sub window_onunload
    if (bStartApp) then
        DisconnectEvents
        set objApp = nothing
        bStartApp = false
    end if
End Sub

dim objApp	'// TC app object
dim bStartApp
bStartApp = false

'// Object names
const ALLTYPES_NAME	= "ALL TYPES"
const BLOCK_NAME	= "BLOCK"
const DATA_NAME		= "DATA"
const LAYER_NAME	= "LAYER"
const LOCALUCS_NAME	= "LOCAL_UCS"
const ROOT_NAME		= "ROOT"
const VERTEX_NAME	= "VERTEX"
const UCS_NAME		= "UCS"

 '// IsGraphicNameImpl
function IsGraphicNameImpl(ObjectName)
    IsGraphicNameImpl = false
    if  ObjectName<>VERTEX_NAME and _
        ObjectName<>LOCALUCS_NAME and _
        ObjectName<>UCS_NAME and _
        ObjectName<>LAYER_NAME and _
        ObjectName<>BLOCK_NAME and _
        ObjectName<>ROOT_NAME and _
        ObjectName<>ALLTYPES_NAME then
     IsGraphicNameImpl = true
    end if
end function '// IsGraphicNameImpl

 '// IsGraphic
function IsGraphic(g)
    IsGraphic = true

    On Error Resume Next
    Err.Clear

    dim GrType
    GrType = g.Type

    if Err.Number <> 0 then
        IsGraphic = false
    end if
end function '// IsGraphic

function GetNodeName(NodeText)
    dim PosChar
    '// Extract usefull word from info string (Vertex 12 -> Vertex)
    PosChar = Instr(NodeText, " ")
    if PosChar <> 0 then
        GetNodeName = Left(NodeText, PosChar - 1)
    else
        GetNodeName = NodeText
    end	if
end function

function GetNodeInfoStr(NodeText)
    dim PosChar
    '// Extract usefull word from info string (Vertex 12 -> Vertex)
    PosChar = Instr(NodeText, " ")
    if PosChar <> 0 then
        GetNodeInfoStr = Right(NodeText, Len(NodeText) - PosChar)
    else
        GetNodeInfoStr = ""
    end	if
end function

'// BOOL openInTC
function openInTC
    dim sMessage, iRes, objTemp
    openInTC = true
    objTemp = NULL

    '// Init
    On Error Resume Next
    Err.Clear

    set objTemp = GetObject("", ObjName)	'// for Pro and Standard version

    if Err.Number > 0 then
        objTemp = NULL

        sMessage = "Can't create TurboCad objects."   + vbCrLf
        sMessage = sMessage + "This tool works only within TurboCad Internet Palette." + vbCrLf
        sMessage = sMessage + "Result may be incorrect." + vbCrLf
        sMessage = sMessage + "Do you want to continue ?"
        iRes = MsgBox(sMessage, vbYesNo + vbInformation, "Plugin " + PLUGIN_NAME + " Warning")
        if (iRes = vbNo) then
            openInTC = false
        end if
        objApp = NULL
    else
        set objApp=objTemp.Application
        bStartApp = true
        set objTemp = Nothing
    end if
end function '// openInTC

'// BOOL isTCVersionOk
function isTCVersionOk
    dim ver, sVer, sBuild, Build, sMessage, iRes
    isTCVersionOk = true

    if (not IsObject(objApp)) then
        exit function
    end if

    '// Ask version and build number
    sVer = objApp.Version(0)
    sBuild = objApp.Build(0)

    '// Avoid Numeric separator problem (. or ,)
    ver = CDbl(Left(sVer, 1)) + 0.1 * CDbl(Mid(sVer, 3, 1))

    if (ver < 6.2) then
        sMessage = "You TurboCad version is " + sVer + "." + vbCrLf
        sMessage = sMessage + "This tool works correctly only with TurboCad version 6.2 or later." + vbCrLf
        sMessage = sMessage + "Do you want to continue ?"
        iRes = MsgBox(sMessage, vbYesNo + vbInformation, "Plugin " + getToolTitle + " Warning", "\help\PluginPack 1.0.chm", 1)

        if (iRes = vbNo) then
            isTCVersionOk = false
        end if
    end if
end function '// isTCVersionOk

function GraphicLayerIsReadOnly(g)
    GraphicLayerIsReadOnly = true
    dim gTmp, gParent
    set gTmp = g
    while (IsGraphic(gTmp))

        if not gTmp.Layer.Editable then
            set gTmp = nothing
            exit function
        end if

        set gParent	= gTmp.Parent
        set gTmp = nothing
        set gTmp = gParent
        set gParent = nothing
    wend
    set gTmp = nothing
    GraphicLayerIsReadOnly = false
end function

function GraphicIsEditableImpl(g)
    GraphicIsEditableImpl = false
    if (not GraphicLayerIsReadOnly(g)) and _
        (g.Editable = true)	then
        GraphicIsEditableImpl = true
    end if
end function

function GraphicCanDeleteVerticesImpl(g)
    dim GrType
    GrType = UCase(g.Type)
    GraphicCanDeleteVerticesImpl = false

    if 	g.Properties("LimitVertices") = 0	and _
        (GrType = "GRAPHIC" or _
             GrType = "TCW25DBLLINE" or _
             GrType = "TCW50POLYLINE" or _
             GrType = "TCW30CURVE" or _
             GrType = "TC_MULTILINE" or _
             GrType = "TCW40EXTRUDE")	 then
        GraphicCanDeleteVerticesImpl = true
    end if
end function

function GraphicCanDeleteChildrensImpl(g)
    GraphicCanDeleteChildrensImpl = false

    if (not IsGraphic(g.Parent)) then '// = Root
        GraphicCanDeleteChildrensImpl = true
    end if
end function

-->
</SCRIPT>

<BODY bgcolor=silver>
</BODY>
</HTML>


Examples - Internet Palette Scripts - StTemplate.htm

StTemplate.htm

Internet Palette Scripts Example

<HTML>
<HEAD>
<META name=VI60_defaultClientScript content=VBScript>
<META name=StTC content=VBScript>
<TITLE>StTC</TITLE>

<SCRIPT ID=Base Name=Base LANGUAGE="VBScript">
option Explicit

'// About
Const StName = "StTemplate"
Const StVer = 1.0

'// resize Behavior vars
dim bCanChangeWidth, bCanChangeHeight, bIsOverPos, bIsShowable
bCanChangeWidth = FALSE
bCanChangeHeight = FALSE
bIsOverPos = FALSE
bIsShowable = FALSE

const nMinHeight = 0
const nMinWidth  = 0
dim nHeight, nWidth
nHeight = 0
nWidth = 0

Sub window_onload
End Sub

dim public_description
set public_description = new Interface

class Interface

    '// TCPlugin
    '// For Scriptlet check
    function TCPlugin
        TCPlugin = TRUE
    end function

    function GetName
        GetName = StName
    end function

    function GetVer
        GetVer = StVer
    end function

    '// Init all Scriptlet's elements
    function Init
        InitUI
        Show
    end function

    function Resize
        InitUI
    end function

    '// Hide all Scriptlet's elements
    function Hide(self)
        self.style.display = "none"
    end function

    '// Show all Scriptlet's elements
    function Show(self)
        self.style.display = ""
    end function

    '// Set Scriptlet's position
    function SetPos(nx1, ny1, nx2, ny2)
    end function

    '// Top
    function Get_Top
    end function
    function Put_Top(y)
    end function

    '// Left
    function Get_Left
    end function
    function Put_Left(x)
    end function

    '// Height
    function Get_Height
    end function
    function Put_Height(h)
    end function

    '// Width
    function Get_Width
    end function
    function Put_Width(w)
    end function

    '// Can Change Heght
    function Get_FixedHeight
    end function

    '// Min Heght
    function Get_MinHeight
    end function

    '// Min Width
    function Get_MinWidth
    end function

end class

'// initUI
'//
sub initUI

end sub '// initUI
-->
</SCRIPT>

<BODY bgcolor=silver>
</BODY>
</HTML>

'<SCRIPT ID=ToolBase LANGUAGE=vbscript>
'<!--
option Explicit
'// Constants //
dim PLUGIN_NAME '// TCW Plugin Tool
dim PLUGIN_VER  '// 1.0

 '// LayOut Constants
const BorderWidth = 2		'// Border for AciveX elements
const ScrollBarWidth = 2	'// Internet palette's scroll Bar
const ScrollBarHeight = 15	'// Internet palette's scroll Bar
const MinHeight = 300
const MinWidth = 100
const SysBtnWidth = 18		'// btnStop, btnAbout
const HeadBarHeight = 21	'// DarkBlue Plugin "System" Bar

'// ToolBar Routine
const tbrPressed	= 1
const tbrUnpressed	= 0
const tbrDefault		= 0
const tbrCheck			= 1
const tbrButtonGroup	= 2
const tbrSeparator		= 3
const tbrPlaceholder	= 4
const tbrDropDown		= 5
dim bInitToolBar
bInitToolBar = false

'// ToolBar's ToolTips
const TT_TLB_LOG = "Logged Drawing"
const TT_TLB_INCLUDEVERTICES = "Include Vertices in Tree"
const TT_TLB_SHOWVERTICEX = "Show selected Vertex's location"
const TT_TLB_CLEARVERTICES = "Clear Vertex's Marks"
const TT_TLB_DIGITS_AFTER_DECIMAL = "Digits after decimal point"
const TT_TLB_Help = "Help"
const TT_TLB_TYPE = "Graphic's Type"
const TT_TLB_DELETE = "Delete"
const TT_TLB_CALC = "Calculator"

'//Global vars
dim objApp							'// TC app object
dim bStartApp, bHideAll, bExitApp	'// State Flags
dim idEvent ,TCEvent				'// TC event routine
dim sBasePath, sPathHelp, sPathCmnImgs, sPathCmnImgsURL	'// Directories

Dim WinX, WinY '// Window size
WinX = -1
WinY = -1

'// Init globals
bStartApp = false
bExitApp = false
bHideAll = false
idEvent = -1

'// Extract path from (path + \name.html)
sBasePath = window.location.pathname
sBasePath = StrReverse(sBasePath)
sBasePath = Right(sBasePath, Len(sBasePath) - InStr(sBasePath, "\") + 1)
sBasePath = StrReverse(sBasePath)

'// For VBScript 3.0 compatibility
dim s
    s = Right(sBasePath, 1)
    if s <> "\" then
        sBasePath = Left(sBasePath , Len(sBasePath) - 1)
    end if

    s = Right(sBasePath, 1)
    if s <> "\" then
        sBasePath = Left(sBasePath , Len(sBasePath) - 1)
    end if

'// Build Help Path
sPathHelp = "file:///" + sBasePath + "help\ID Keeper.chm"

'// Build Path to Common Images
sPathCmnImgs = sBasePath + "CommonImages\"
sPathCmnImgs = Right(sPathCmnImgs, Len(sPathCmnImgs) - 1)
sPathCmnImgsURL = "file:///" + sBasePath + "CommonImages\"

'// getToolTitle
'//
function getToolTitle
    getToolTitle = PLUGIN_NAME + " " + FormatNumber(PLUGIN_VER, 1, true)
end function

'// initObjects
'//
sub initObjects
    InitSpecificObjects '// Specific part
end sub

'// clearObjects
'//
sub clearObjects
    if (bStartApp) then

        ClearSpecificObjects '// Specific part

        '// objApp release
        set objApp = nothing
        bStartApp = false
    end if
end sub '// clearObjects

'// hideAll
'//
sub hideAll
    clearObjects
    top.frames.item(0).LabelAboutID.style.color = &HC0C0C0

    LabelAboutID.style.BACKGROUNDCOLOR = &H808080
    LabelAboutID.style.backgroundImage  = "none"
    LabelDisable.style.display = ""

    call HideAllSpecificObjects '// Specific part

    bHideAll = true
end sub '// hideAll

'// BOOL isScriptVersionOK
function isScriptVersionOK
    dim ver, sVer, sMessage, iRes
    ver = CInt(ScriptEngineMajorVersion)
    sVer = CStr(ver)
    isScriptVersionOK = true

    if (ver < 5) then
        sMessage = "VBScript version " + sVer + " is detected in the system." +	vbCrLf
        sMessage = sMessage + PLUGIN_NAME + " needs version 5 or later." + vbCrLf
        sMessage = sMessage + "With using earlier VBScript version the result of tool working may be not fully correct." + vbCrLf
        sMessage = sMessage + "Do you want to continue ?"
        iRes = MsgBox(sMessage, vbYesNo + vbInformation, "Plugin " + PLUGIN_NAME + " Warning")
        if (iRes = vbNo) then
            isScriptVersionOK = false
        end if
    end if
end function '// isScriptVersionOK

'// BOOL isInitUIOK
function isInitUIOK
    isInitUIOK = false

    'Alert document.frames.length
    LabelAboutID.innerText = "    " + getToolTitle

    LabelDisable.innerText = " '" + getToolTitle + "' is deactivated." + vbCrLf + " Click mouse inside for activaite."
    LabelDisable.style.display = "none"

    initUI
    LabelAboutID.style.display = ""
    btnStop.style.display = ""
    btnAbout.style.display = ""

    InitToolUI

    'dim scr
    'set scr = top.document.scripts.item(0)
    'Alert scr.ID

    isInitUIOK = true
end function '// isInitUIOK

'// BOOL openInTC
function openInTC
    dim sMessage, iRes, objTemp
    openInTC = true
    objTemp = NULL

    '// Init
    On Error Resume Next
    Err.Clear

    set objTemp = GetObject("", "IMSIGX.Vertex")

    if Err.Number > 0 then
        objTemp = NULL

        sMessage = "I can't get TurboCad's objects."   + vbCrLf
        sMessage = sMessage + "This tool works only with TurboCad Internet Palette." + vbCrLf
        sMessage = sMessage + "The result of working may be not fully correct." + vbCrLf
        sMessage = sMessage + "Do you want to continue ?"
        iRes = MsgBox(sMessage, vbYesNo + vbInformation, "Plugin " + PLUGIN_NAME + " Warning")
        if (iRes = vbNo) then
            openInTC = false
        end if
        objApp = NULL
    else
        set objApp=objTemp.Application
        bStartApp = true
        set objTemp = Nothing
    end if

end function '// openInTC

'// BOOL isTCVersionOk
function isTCVersionOk
    dim ver, sVer, sBuild, Build, sMessage, iRes
    isTCVersionOk = true

    if (not IsObject(objApp)) then
        exit function
    end if

    '// Ask version and build number
    sVer = objApp.Version(0)
    sBuild = objApp.Build(0)

    '// Avoid Numeric separator problem (. or ,)
    ver = CDbl(Left(sVer, 1)) + 0.1 * CDbl(Mid(sVer, 3, 1))

    if (ver < 6.2) then
        sMessage = "You TurboCad version is " + sVer + "." + vbCrLf
        sMessage = sMessage + "This tool works correctly only with TurboCad version 6.1 or later." + vbCrLf
        sMessage = sMessage + "Do you want to continue ?"
        iRes = MsgBox(sMessage, vbYesNo + vbInformation, "Plugin " + getToolTitle + " Warning", "\help\PluginPack 1.0.chm", 1)

        if (iRes = vbNo) then
            isTCVersionOk = false
        end if
    end if
end function '// isTCVersionOk

'// startUp
'// Check Script, TCW, Init all global vars
Sub startUp
    if not(isScriptVersionOK) then
        Exit sub
    end if

'	if not(LoadSettings) then
'		Exit sub
'	end if

    if not(isInitUIOK) then
        Exit sub
    end if

    if not(openInTC) then
        Exit sub
    end if

    if not(isTCVersionOk) then
        Exit sub
    end if

     window.setTimeout "initObjects", 0
end sub '// startUp

'// getDocHeight
function getDocHeight
    dim  DocHeight
    DocHeight = document.body.offsetHeight

    '// Check minimum sizes
    if (DocHeight < MinHeight) then
        DocHeight = MinHeight '// 200
    end if

    getDocHeight = DocHeight - HeadBarHeight
end function'// getDocHeight

'// getDocWidth
function getDocWidth
    dim  DocWidth
    DocWidth = document.body.offsetWidth
    DocWidth = DocWidth - ScrollBarWidth

    if (DocWidth < MinWidth) then
        DocWidth = MinWidth	'// 100
    end if
    getDocWidth = DocWidth
end function'// getDocWidth

'// initUI
'//
sub initUI
    dim  DocWidth
    DocWidth = getDocWidth

    '// Horizontal sizes
    LabelAboutID.Style.LEFT = 0
    LabelAboutID.Style.width =  DocWidth - Borderwidth

    btnStop.Style.LEFT = DocWidth - SysBtnWidth - Borderwidth
    btnStop.style.backgroundImage  = "url(" + sPathCmnImgsURL + "Stop.bmp" + ")"

    btnAbout.Style.LEFT = DocWidth - 2* SysBtnWidth - Borderwidth
    btnAbout.style.backgroundImage  = "url(" + sPathCmnImgsURL + "About.bmp" + ")"

    '// Skip another properties
    if bHideAll then
        exit sub
    end if

    LabelAboutID.style.color = &HFFFFFF
    LabelAboutID.style.BACKGROUNDCOLOR = &H8b
    LabelAboutID.style.backgroundImage  = "url(" + sPathCmnImgsURL + "Plugin_label.bmp" + ")"
end sub '// initUI

Sub btnAbout_onclick
    dim sMessage
    sMessage = sMessage + "HTML Plugin for TurboCAD v6." + vbCrLf
    sMessage = sMessage + PLUGIN_NAME + " v" + FormatNumber(PLUGIN_VER, 1, true) + vbCrLf

    call MsgBox(sMessage, vbOKOnly, "About")

    '//showHelp sPathHelp
end sub

Sub btnStop_onclick
    hideAll
    'btnStop.disabled  = 1
end sub

'/////////// window events ////////////
'//
Sub window_onload
    startUp
end sub '// window_onload

Sub window_onhelp
    showHelp sPathHelp
end sub

Sub document_onhelp
    showHelp sPathHelp
end sub

Sub window_onunload
    clearObjects
end sub

sub window_onfocus
    if bHideAll then
        bHideAll = false
        startUp
    end if
end sub

sub window_onresize
    '// Prevent from empty calls
    if (document.body.offsetWidth <> WinX) or ((document.body.offsetHeight <> WinY)) then
        WinX = document.body.offsetWidth
        WinY = document.body.offsetHeight
        initUI
        InitToolUI	'//Specific part
    end if
end sub
'///////////////////////////////////

'-->
'</SCRIPT>


Examples - Internet Palette Scripts - StText.htm

StText.htm

Internet Palette Scripts Example

<HTML>
<HEAD>
<META name=VI60_defaultClientScript content=VBScript>
<META name=StDrawingTree content=VBScript>
<TITLE>StTC</TITLE>

<SCRIPT ID=StDrawingTree Name=StDrawingTree LANGUAGE="VBScript">
option Explicit

'// About
Const StName = "StText"
Const StVer = 1.0

'// resize Behavior vars
dim bCanChangeWidth, bCanChangeHeight, bIsOverPos, bIsShowable
bCanChangeWidth = TRUE
bCanChangeHeight = TRUE
bIsOverPos = FALSE
bIsShowable = TRUE

const nMinHeight = 100
const nMinWidth  = 100
dim nHeight, nWidth
nHeight = 0
nWidth = 0

dim public_description
set public_description = new Interface
class Interface

    '// TCPlugin
    '// For Scriptlet check
    function TCPlugin
        TCPlugin = TRUE
    end function

    function GetName
        GetName = StName
    end function

    function GetVer
        GetVer = StVer
    end function

    function Get_CanChangeWidth
        Get_CanChangeWidth = bCanChangeWidth
    end function

    function Get_CanChangeHeight
        Get_CanChangeHeight = bCanChangeHeight
    end function

    function Put_CanChangeHeight(b)
        bCanChangeHeight = b
    end function

    function Get_IsOverPos
        Get_IsOverPos = bIsOverPos
    end function

    function Get_IsShowable
        Get_IsShowable = bIsShowable
    end function

    function Put_IsShowable(b)
        bIsShowable = b
    end function

    '// Min Heght
    function Get_MinHeight
        Get_MinHeight = nMinHeight
    end function

    '// Min Width
    function Get_MinWidth
        Get_MinWidth = nMinWidth
    end function

    '// Get Heght
    function GetHeight
        GetHeight = nHeight
    end function

    '// Get Width
    function GetWidth
        GetWidth = nWidth
    end function

    '// Set Heght
    function SetHeight(self, Height)
        nHeight = Height
        self.Height = Height
        CustomText.Style.Height = Height
    end function

    '// Set Width
    function SetWidth(self, Width)
        nWidth = Width
        self.Width = Width
        CustomText.Style.Width = Width
        CustomText.Style.Width = Width
    end function

    '// MoveTo
    function MoveTo(self, Left, Top)
        self.style.Left = Left
        self.style.Top = Top
    end function

    '// Init all Scriptlet's elements
    function Init
        InitUI
        Show
    end function

    '// Hide all Scriptlet's elements
    function Hide(self)
        self.style.display = "none"
    end function

    '// Show all Scriptlet's elements
    function Show(self)
        self.style.display = ""
    end function

    function Get_Value
        Get_Value = CustomText.value
    end function

    function Put_Value(s)
        CustomText.value = s
    end function

end class

'// initUI
'//
sub initUI
end sub '// initUI

Sub window_onload
End Sub

Sub document_onkeydown
    window.external.bubbleEvent
End Sub

-->
</SCRIPT>

<BODY bgcolor=silver style="FONT-FAMILY: sans-serif; FONT-SIZE: x-small">
<TEXTAREA id=CustomText name=CustomText style="HEIGHT: 309px; LEFT: 0px; POSITION: absolute; TOP: 1px; WIDTH: 253px; Z-INDEX: 107"></TEXTAREA>
</BODY>
</HTML>


Examples - Internet Palette Scripts - StToolBar.htm

StToolBar.htm

Internet Palette Scripts Example

<HTML>
<HEAD>
<META name=VI60_defaultClientScript content=VBScript>
<META name=StToolBar content=VBScript>
<TITLE>StToolBar</TITLE>

<SCRIPT ID=StHead Name=StHead LANGUAGE="VBScript">
option Explicit

'// About
Const StName = "StTemplate"
Const StVer = 1.0

'// resize Behavior vars
dim bCanChangeWidth, bCanChangeHeight, bIsOverPos, IsShowable
bCanChangeWidth = FALSE
bCanChangeHeight = FALSE
bIsOverPos = FALSE
IsShowable = TRUE

const nMinHeight = 0
const nMinWidth  = 0
dim nHeight, nWidth
nHeight = 0
nWidth = 0

dim public_description
set public_description = new Interface
class Interface

    '// TCPlugin
    '// For Scriptlet check
    function TCPlugin
        TCPlugin = TRUE
    end function

    function GetName
        GetName = StName
    end function

    function GetVer
        GetVer = StVer
    end function

    function Get_CanChangeWidth
        Get_CanChangeWidth = bCanChangeWidth
    end function

    function Get_CanChangeHeight
        Get_CanChangeHeight = bCanChangeHeight
    end function

    function Get_IsOverPos
        Get_IsOverPos = bIsOverPos
    end function

    function Get_IsShowable
        Get_IsShowable = IsShowable
    end function

    '// Min Heght
    function Get_MinHeight
        Get_MinHeight = nMinHeight
    end function

    '// Min Width
    function Get_MinWidth
        Get_MinWidth = nMinWidth
    end function

    '// Get Heght
    function GetHeight
        GetHeight = nHeight
    end function

    '// Get Width
    function GetWidth
        GetWidth = nWidth
    end function

    '// Set Heght
    function SetHeight(self, Height)
        Height = nHeight
    end function

    '// Set Width
    function SetWidth(self, Width)
        nWidth = Width
    end function

    '// MoveTo
    function MoveTo(self, Left, Top)
        self.style.Left = Left
        self.style.Top = Top
    end function

    '// Init all Scriptlet's elements
    function Init
        InitUI
        Show
    end function

    '// Hide all Scriptlet's elements
    function Hide(self)
        self.style.display = "none"
    end function

    '// Show all Scriptlet's elements
    function Show(self)
        self.style.display = ""
    end function

    '// Set Scriptlet's position
    function SetPos(nx1, ny1, nx2, ny2)
        document.body.style.top = ny1
        document.body.style.height = n2 - ny1 + 1
        document.body.style.left = nx1
        document.body.style.width = nx2 - nx1 + 1

        x1 = nx1
        y1 = ny1
        x2 = nx2
        y2 = ny2
    end function

'///////////////////////////////////////////////////////
    '// Image List
    function ClearImages
        ToolBarImgList.ListImages.Clear
    end function
    function AddImage(ImgName, FileName)
        ToolBarImgList.ListImages.Add  ,ImgName , LoadPicture(FileName)
    end function

    '// ToolBar set ImageList
    function SetImageList()
        Toolbar1.ImageList  = ToolBarImgList
    end function

    function Get_ToolBar
        set Get_ToolBar = ToolBar1
    end function

    function Get_ImgList
        set Get_ImgList = ToolBarImgList
    end function

    function Get_tbrPressed
        Get_tbrPressed	= tbrPressed
    end function

    function Get_tbrUnpressed
        Get_tbrUnpressed	= tbrUnpressed
    end function

    function Get_tbrDefault
        Get_tbrDefault	= tbrDefault
    end function

    function Get_tbrCheck
        Get_tbrCheck		= tbrCheck
    end function

    function Get_tbrButtonGroup
        Get_tbrButtonGroup = tbrButtonGroup
    end function

    function Get_tbrSeparator
        Get_tbrSeparator	= tbrSeparator
    end function

    function Get_tbrPlaceholder
        Get_tbrPlaceholder = tbrPlaceholder
    end function

    function Get_tbrDropDown
        Get_tbrDropDown = tbrDropDown
    end function

end class

'// initUI
'//
sub initUI
end sub '// initUI

Sub window_onload
End Sub

Sub Toolbar1_ButtonClick(Button)
    window.external.raiseEvent "ButtonClick", Button
End Sub

Sub Toolbar1_ButtonMenuClick(ButtonMenu)
    window.external.raiseEvent "MenuClick", ButtonMenu
End Sub

'// ToolBar Routine
const tbrPressed		= 1
const tbrUnpressed		= 0
const tbrDefault		= 0
const tbrCheck			= 1
const tbrButtonGroup	= 2
const tbrSeparator		= 3
const tbrPlaceholder	= 4
const tbrDropDown		= 5
dim bInitToolBar

-->
</SCRIPT>

<BODY bgcolor=silver>

<!------------------ Ex. Controls: ToolBarImgList, Toolbar1-------------------------->
<OBJECT classid=clsid:2C247F23-8591-11D1-B16A-00C0F0283628 id=ToolBarImgList
style="LEFT: 0px; POSITION: absolute; TOP: 0px; Z-INDEX: 104"><PARAM NAME="_ExtentX" VALUE="804"><PARAM NAME="_ExtentY" VALUE="804"><PARAM NAME="BackColor" VALUE="-2147483624"><PARAM NAME="ImageWidth" VALUE="16"><PARAM NAME="ImageHeight" VALUE="15"><PARAM NAME="MaskColor" VALUE="12632256"><PARAM NAME="UseMaskColor" VALUE="-1"><PARAM NAME="_Version" VALUE="393216"></OBJECT>
<OBJECT classid=clsid:66833FE6-8583-11D1-B16A-00C0F0283628 height=24 id=Toolbar1
style="BORDER-BOTTOM-COLOR: aliceblue; BORDER-LEFT-COLOR: silver; BORDER-RIGHT-COLOR: silver; BORDER-TOP-COLOR: silver; HEIGHT: 24px; LEFT: 0px; POSITION: absolute; TOP: 0px; WIDTH: 2000px; Z-INDEX: 105"
width=2000><PARAM NAME="_ExtentX" VALUE="42333"><PARAM NAME="_ExtentY" VALUE="508"><PARAM NAME="ButtonWidth" VALUE="487"><PARAM NAME="ButtonHeight" VALUE="466"><PARAM NAME="ToolTips" VALUE="1"><PARAM NAME="AllowCustomize" VALUE="0"><PARAM NAME="Wrappable" VALUE="0"><PARAM NAME="Appearance" VALUE="1"><PARAM NAME="HelpContextID" VALUE="0"><PARAM NAME="HelpFile" VALUE=""><PARAM NAME="Style" VALUE="1"><PARAM NAME="TextAlignment" VALUE="0"><PARAM NAME="ImageList" VALUE=""><PARAM NAME="DisabledImageList" VALUE=""><PARAM NAME="HotImageList" VALUE=""><PARAM NAME="_Version" VALUE="393216"><PARAM NAME="BorderStyle" VALUE="1"><PARAM NAME="MousePointer" VALUE="0"><PARAM NAME="Enabled" VALUE="1"><PARAM NAME="OLEDropMode" VALUE="1"></OBJECT>

</BODY>
</HTML>


Examples - Script Host Scripts - turboCAD Test1.vbs

turboCAD Test1.vbs

Script Host Scripts Example

Option Explicit

Dim tcApp
Dim tcDwg

Dim TORADIANS
Dim bContinue

'================== ShowDrawings ========================================
Sub ShowDrawings()
      Dim cnt
    Dim tcDwgs
    Dim tcDwg
    Dim strMsg

    Set tcDwgs = tcApp.Drawings
    cnt = tcDwgs.Count
    MsgBox "Drawings count: " & CStr(cnt)

    If (cnt = 0) Then
        bContinue = False
        Exit Sub
    End If

    For Each tcDwg in tcDwgs
        strMsg = strMsg & tcDwg.Name
        strMsg = strMsg & Chr(13) & Chr(10)
    Next
    MsgBox strMsg

End Sub

'================== ShowFilters ========================================
Sub ShowFilters()
    Dim tcFlts
    Dim tcFlt
    Dim strMsg

    Set tcFlts = tcApp.Filters
    MsgBox "Filters count: " & CStr(tcFlts.Count)

    For Each tcFlt in tcFlts
        strMsg = strMsg & tcFlt.Name
        strMsg = strMsg & Chr(13) & Chr(10)
    Next
    MsgBox strMsg

End Sub

'================= ShowRegenMethods =========================================

Sub ShowRegens()
    Dim tcRms
    Dim tcRm
    Dim strMsg

    Set tcRms = tcApp.RegenMethods
    MsgBox "Regen Methods count: " & CStr(tcRms.Count)

    For Each tcRm in tcRms
        strMsg = strMsg & tcRm.Name
        strMsg = strMsg & Chr(13) & Chr(10)
    Next
    MsgBox strMsg

End Sub

'================= ShowTieMethods =========================================
Sub ShowTieMethods()

    Dim tcTms
    Dim tcTm
    Dim strMsg

    Set tcTms = tcApp.TieMethods
    MsgBox "Tie Methods count: " & CStr(tcTms.Count)

    For Each tcTm in tcTms
        strMsg = strMsg & tcTm.Name
        strMsg = strMsg & Chr(13) & Chr(10)
    Next
    MsgBox strMsg

End Sub

'================= ShowRenders =========================================
Sub ShowRenders()
    Dim tcRnds
    Dim tcRnd
    Dim strMsg

    Set tcRnds = tcApp.Renders
    MsgBox "Renders count: " & CStr(tcRnds.Count)

    For Each tcRnd in tcRnds
        strMsg = strMsg & tcRnd.Name
        strMsg = strMsg & Chr(13) & Chr(10)
    Next
    MsgBox strMsg

End Sub

'================ AddGraphics ==========================================
Sub AddGraphics(tcGrs)

Dim tcGr1
Dim tcGr2

    MsgBox "Graphics count: " & CStr(tcGrs.Count)

    Set tcGr1 = tcGrs.AddArcCenterAndPoint(0, 0, 0, 1, 1, 0, 0, 90 * TORADIANS)

'	tcGr1.MoveAbsolute 1, 1, 0

    Set tcGr2 = tcGrs.AddArcCenterAndPoint(0, 0, 0, 2, 2, 0, 0, 90 * TORADIANS)
    tcGr2.Properties("PenColor") = RGB(255, 128, 64)
    tcGrs.Remove tcGr2.Index
    tcGrs.AddGraphic tcGr2, tcGr1.Index

    MsgBox "Graphics count: " & CStr(tcGrs.Count)

End Sub

'================ CreateBlock ==========================================
Sub CreateBlock(tcGrs)
Dim tcDwg

    Set tcDwg = tcGrs.Drawing
    MsgBox "Blocks count: " & tcDwg.Blocks.Count

    tcGrs.CreateBlock "MyBlock"

    MsgBox "Blocks count: " & tcDwg.Blocks.Count

End Sub

'================ CreateXRefBlock ========================================
Sub CreateXRefBlock(tcDwg)
    Dim tcBlks

    Set tcBlks = tcDwg.Blocks
    MsgBox "Blocks count: " & tcBlks.Count

    tcBlks.AddXRef "", "e:\tc70\bin\usa\drawing\drawing1.tcw"

    MsgBox "Blocks count: " & tcBlks.Count

End Sub

'================ ViewZoom ================================================
Sub ViewZoom(tcVw)

Dim tcCam
Dim xC
Dim yC
Dim w
Dim h
Dim ZOOM_FACTOR

    ZOOM_FACTOR = 1.2

    If (tcVw.SpaceMode = 1) Then

        Set tcCam = tcVw.Camera
        tcCam.Zoom ZOOM_FACTOR
        MsgBox "Zoom"

    Else

        w = tcVw.ViewWidth
        h = tcVw.ViewHeight

        xC = tcVw.ViewLeft + w / 2
        yC = tcVw.ViewTop - h / 2

        w = w * ZOOM_FACTOR
        h = h * ZOOM_FACTOR

        tcVw.Update = False
        tcVw.ViewLeft = xC - w / 2
        tcVw.ViewTop  = yC + h / 2

        tcVw.Update = True

    End If

    MsgBox "Zoom"

    tcVw.Update = False
    tcVw.Margins = True
    tcVw.ZoomToExtents
    MsgBox "Zoom All"

End Sub

'================ ShowAppInfo ================================================
Sub ShowAppInfo()
Dim cnt

    tcApp.Visible = True

'	MsgBox "Current Snap modes: " & CStr(tcApp.SnapModes)

    ShowRegens
'	ShowRenders
'	ShowFilters
'	ShowTieMethods
'	ShowDrawings

    bContinue = False
End Sub

'================ EditDrawing ================================================
Sub MirrorSelection (tcDwg)

Dim tcMtx

Dim tcVw
Dim tcPickRes

Dim tcSelection
Dim tcBBox

Dim tcGr
Dim tcGrM
Dim tcVrt0
Dim tcVrt1

Dim xC
Dim yC
Dim zC
Dim angle
Dim dx
Dim dy
Dim dz

    Set tcSelection = tcDwg.Selection
    if (tcSelection.Count = 0) then exit sub

    MsgBox "Click mirror line"
    Set tcVw = tcDwg.ActiveView
    tcVw.GetMouseClick xC, yC

    Set tcPickRes = tcVw.PickPoint(xC, yC)
    if (tcPickRes.Count = 0) then exit sub

    Set tcVrt0 = tcPickRes(0).ClosestVertex
    tcVw.WorldToView tcVrt0.X, tcVrt.Y, tcVrt.Z, xC, yC, zC

    Set tcGr = tcPickRes(0)
    tcGr.GetDistance xC, yC, zC, , tcGrM

    Set tcVrt0 = tcGrm.Vertices(0)
    Set tcVrt1 = tcGrM.Vertices(1)

    dx = tcVrt1.X - tcVrt0.X
    dy = tcVrt1.Y - tcVrt0.Y
    if dx = 0 then
        angle = - 90 * TORADIANS
    else
        angle = -Atn(dy / dx)
    end if

'	Set tcBBox = tcSelection.CalcBoundingBox
'	xC = (tcBBox.Min.X + tcBBox.Max.X) / 2
'	yC = (tcBBox.Min.Y + tcBBox.Max.Y ) / 2
'	yC = (tcBBox.Min.Z + tcBBox.Max.Z ) / 2

    Set tcMtx = CreateObject("TurboCAD.Matrix")
'	tcMtx.TranslateScaleAndRotateZ 8, 8, 0,  1, 1, 1, 360 * TORADIANS
'	tcMtx.Translate 8, 8, 0

'	for each tcGr in tcSelection
'		tcGr.MoveRelative 8, 8, 0
'		tcGr.Update
'		tcGr.Select
'	next

    for each tcGr in tcSelection
        tcGr.RotateAxis angle, 0, 0, 1, tcVrt0.X, tcVrt0.Y, tcVrt0.Z
        tcGr.Update
        tcGr.Select
    next

'	for each tcGr in tcSelection
'		tcGr.RotateAxis -90 * TORADIANS, 0, 0, 1
'		tcGr.Update
'		tcGr.Select
'	next

    Set tcBBox = tcSelection.CalcBoundingBox
    xC = (tcBBox.Min.X + tcBBox.Max.X) / 2
    yC = (tcBBox.Min.Y + tcBBox.Max.Y ) / 2
    yC = (tcBBox.Min.Z + tcBBox.Max.Z ) / 2

    tcMtx.Identity
    tcMtx.TranslateScaleAndRotateZ 0, 0, 0, -1, 1, 1, 360 * TORADIANS, xC, yC, zC

    for each tcGr in tcSelection
        tcGr.Transform tcMtx
        tcGr.Update
        tcGr.Select
    next
end sub

'================ EditDrawing ================================================
Sub EditDrawing(tcDwg)
Dim tcGrs

    Set tcGrs = tcDwg.Graphics

    AddGraphics tcGrs
'	CreateBlock tcGrs
'	CreateXRefBlock tcDwg
'	MirrorSelection tcDwg

    ViewZoom tcDwg.ActiveView
End Sub

'================ CloseDrawing ================================================
Sub CloseDrawing(tcDwg)

    tcDwg.Close False

End Sub

'================ Main =================================================
Sub Main ()

    Set tcApp = CreateObject("TurboCAD.Application")
'	Set tcDwg = CreateObject("TurboCAD.Drawing")
'	Set tcApp = tcDwg.Application
    tcApp.Visible = false
    tcApp.Visible = true

    ShowAppInfo

    If (bContinue = False) Then
        Exit Sub
    End If

'	EditDrawing tcDwg
'	CloseDrawing tcDwg

'	ShowDrawings

End Sub

    TORADIANS = 3.14159265358979 / 180
    bContinue = True

    Main

'	tcApp.Quit

    MsgBox "Done"


Examples - Script Host Scripts - TurboCAD test2.vbs

TurboCAD test2.vbs

Script Host Scripts Example

'Script to test for adding graphics to the drawing

Option Explicit

Dim TORADIANS
Dim tcApp

'================= Add graphic the tail of collection
Sub AddTail(tcGrs)

Dim tcGr
    Set tcGr = tcGrs.AddArcCenterAndPoint(0, 0, 0, 1, 1, 0, 0, 90 * TORADIANS)
    tcGr.Properties("PenColor") = RGB(0, 0, 255)

    MsgBox "Graphics count: " & CStr(tcGrs.Count) & " Graphic added to the " & CStr(tcGr.Index)

end sub

'================= Add graphic the head of collection
Sub AddHead(tcGrs)

Dim tcGr
    Set tcGr = tcGrs.AddArcCenterAndPoint(2, 2, 0, 1, 1, 0, -180 * TORADIANS, -90 * TORADIANS)
    tcGr.Properties("PenColor") = RGB(255, 0, 0)

    tcGrs.Remove tcGr.Index

    tcGrs.AddGraphic tcGr, 0
    MsgBox "Graphics count: " & CStr(tcGrs.Count) & " Graphic added to the " & CStr(tcGr.Index)

end sub

'================= Add graphic the middle of collection
Sub AddMiddle(tcGrs)
Dim tcGr
    Set tcGr = tcGrs.AddArcCenterAndPoint(1, 0, 0, 1, 1, 0, 90 * TORADIANS, 180 * TORADIANS)
    tcGr.Properties("PenColor") = RGB(0, 255, 0)

    tcGrs.Remove tcGr.Index

    tcGrs.AddGraphic tcGr, 1
    MsgBox "Graphics count: " & CStr(tcGrs.Count) & " Graphic added to the " & CStr(tcGr.Index)
end sub

Sub Main()

Dim cnt
Dim tcDwgs
Dim tcDwg
Dim tcGrs

    Set tcDwgs = tcApp.Drawings
    cnt = tcDwgs.Count
    MsgBox "Drawings count: " & CStr(cnt)

    If (cnt = 0) Then
        Exit Sub
    End If

    Set tcDwg = tcApp.ActiveDrawing
    Set tcGrs = tcDwg.Graphics

    MsgBox "Graphics count: " & CStr(tcGrs.Count)

    AddTail tcGrs

    AddHead tcGrs

    AddMiddle tcGrs

    tcDwg.ActiveView.Refresh
end sub

    TORADIANS = 3.14159265358979 / 180
    Set tcApp = CreateObject("TurboCAD.Application")

    Main

    MsgBox "Done"


Examples - Script Host Scripts - TurboCAD Test3.vbs

TurboCAD Test3.vbs

Script Host Scripts Example

'Script to test for adding vertices to the selected graphic

Option Explicit

Dim tcApp

'================= Add Vertex the tail of collection
Sub AddTail(tcVrts)

Dim tcVrt
Dim cnt
Dim X
Dim Y
Dim Z

    cnt = tcVrts.Count

    Set tcVrt = tcVrts(cnt - 1)
    X = tcVrt.X + 1
    Y = tcVrt.y + 1
    z = tcVrt.z

    Set tcVrt = tcVrts.Add(x, y, z)

    MsgBox "Vertices count: " & CStr(tcVrts.Count) & " Vertex added to the " & CStr(tcVrt.Index)

end sub

'================= Add Vertex the head of collection
Sub AddHead(tcVrts)

Dim tcVrt

Dim X
Dim Y
Dim Z

    Set tcVrt = tcVrts(0)

    X = tcVrt.X - 1
    Y = tcVrt.y - 1
    z = tcVrt.z

    Set tcVrt = tcVrts.Add(x, y, z, , , , , , , 0)

    MsgBox "Vertices count: " & CStr(tcVrts.Count) & " Vertex added to the " & CStr(tcVrt.Index)

end sub

'================= Add Vertex the middle of collection
Sub AddMiddle(tcVrts)

Dim tcVrt

Dim tcVrt0
Dim tcVrt1

Dim X
Dim Y
Dim Z

    Set tcVrt0 = tcVrts(0)
    Set tcVrt1 = tcVrts(1)

    X = (tcVrt1.X + tcVrt0.X) / 2
    Y = (tcVrt1.y + tcVrt0.y) / 2
    z = (tcVrt1.z + tcVrt0.z) / 2

    Set tcVrt = tcVrts.Add(x, y, z, , , , , , , , tcVrt0)

    MsgBox "Vertices count: " & CStr(tcVrts.Count) & " Vertex added to the " & CStr(tcVrt.Index)

end sub

Sub Main()

Dim cnt
Dim tcSel
Dim tcDwg
Dim tcVrts

    Set tcSel = tcApp.Selection
    cnt = tcSel.Count
    MsgBox "Selection count: " & CStr(cnt)

    If (cnt <> 1) Then
        Exit Sub
    End If

    Set tcDwg = tcApp.ActiveDrawing
    Set tcVrts = tcSel(0).Vertices

    AddTail tcVrts

    AddHead tcVrts

    AddMiddle tcVrts

    tcSel(0).Closed = False
    tcSel(0).Select
    tcDwg.ActiveView.Refresh
end sub

    Set tcApp = CreateObject("TurboCAD.Application")
    tcApp.Visible = True

    Main

    MsgBox "Done"


Examples - Script Host Scripts - TurboCAD Test4.vbs

TurboCAD Test4.vbs

Script Host Scripts Example

'Script to test getting/setting reference point of the graphic

Option Explicit

Dim tcApp

sub ShowRefPoint(tcGr, bUseWorldCS)

Dim tcVrtRef
Dim strMsg

    Set tcVrtRef = tcGr.ReferencePoint(bUseWorldCS)

    strMsg = "RefPoint of " & CStr(tcGr.ID)
    strMsg = strMsg & Chr(13) & Chr(10)

    strMsg = strMsg & "X = " & CStr(tcVrtRef.X)
    strMsg = strMsg & Chr(13) & Chr(10)

    strMsg = strMsg & "Y = " & CStr(tcVrtRef.Y)
    strMsg = strMsg & Chr(13) & Chr(10)

    strMsg = strMsg & "Z = " & CStr(tcVrtRef.Z)
    strMsg = strMsg & Chr(13) & Chr(10)

    if (Not bUseWorldCS) then
        strMsg = strMsg & "(Local CS)"
    else
        strMsg = strMsg & "(World CS)"
    end if

    msgBox strMsg
end sub

Sub EditRefPoint(tcGr)

Dim tcVrtRef

    ShowRefPoint tcGr, false
    ShowRefPoint tcGr, true

    Set tcVrtRef = tcGr.ReferencePoint

    tcVrtRef.X = tcVrtRef.X + 1
    tcVrtRef.y = tcVrtRef.y + 1
    tcVrtRef.z = tcVrtRef.z + 1

    ShowRefPoint tcGr, false

end sub

Sub UpdateSelector()

Dim tcSel

    Set tcSel = tcApp.Selection
    if (tcSel.Count = 0) then exit sub

    tcSel(0).Select

end sub

Sub Main()

Dim tcDwg
Dim tcGrs
Dim tcGr

    Set tcDwg = tcApp.ActiveDrawing

    Set tcGrs = tcDwg.Graphics

    for each tcGr in tcgrs
        EditRefPoint(tcGr)
    next

    UpdateSelector

end sub

    Set tcApp = CreateObject("TurboCAD.Application")
    tcApp.Visible = True

    Main

    MsgBox "Done"


Examples - Script Host Scripts - TurboCADTest5 .vbs

TurboCADTest5 .vbs

Script Host Scripts Example

Option Explicit

Dim fso
Dim f
Dim FilePath
Dim TextLine

Dim tcApp
Dim ActiveDrawing

Sub LoadText()

Dim gxGrs
Dim gxGr

Dim x
Dim y

    x = 0
    y = 0

    FilePath = "J:\TurboCADSDK\Program\VBA\LoadLine\mdlLoadLine.bas"
    Set f = fso.OpenTextFile(FilePath, 1)

    MsgBox FilePath & " opened"

    Set gxGrs = ActiveDrawing.Graphics
    Do While Not f.AtEndOfStream ' Loop until end of file.
        TextLine = f.ReadLine

        Set gxGr = gxGrs.AddText(TextLine, x, y, 0, 10)
        gxGr.Draw
        y = y + 10
    Loop

    f.Close

    ActiveDrawing.ActiveView.ZoomToExtents

    MsgBox "Done"

End Sub

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set tcApp = CreateObject("TurboCAD.Application")
    Set ActiveDrawing = tcApp.ActiveDrawing
    LoadText


Examples - Script Host Scripts - TurboCADTest6.vbs

TurboCADTest6.vbs

Script Host Scripts Example

Option Explicit

Const imsiPolyline = 11
Const imsi3DMesh = 3

Dim tcApp
Dim tcDwgs
Dim tcDwg
Dim tcGrs
Dim tcVw

Dim fso
Dim f
Dim fName
Dim rootPath

Dim bSolid

Sub DumpProp(tcProp)

   f.WriteLine tcProp.Name + " " + CStr(tcProp.Value)

end sub

Sub DumpProps(tcProps)

Dim tcPropType
Dim tcProp
Dim idProp
Dim bNew

   On Error Resume Next
   Set tcPropType = tcProps("RegenMethod")
   fName = rootPath & "\" & tcPropType.Value & ".txt"

   bNew = fso.FileExists(fName)
   Set f = fso.OpenTextFile(fName, 8, True)
   if (Err.Number <> 0) then
        MsgBox Err.Description
        Exit Sub
   end if

   if (Not bNew) then
       f.WriteLine tcPropType.Value
   else
       f.WriteLine ""
   end if

   for each tcProp in tcProps
       idProp = tcProp.ID
       if (Err.Number <> 0) then

           DumpProp tcProp

       end if
   next

   f.Close

end sub

Sub CreateMesh()

Dim tcGrMesh
Dim tcPropsMesh
Dim tcVrtsMesh
Dim cx
Dim cy
Dim dx
Dim dy
Dim dz
Dim x
Dim y
Dim z
Dim indX
Dim indY

    cx = 9
    cy = 9
    dx = 1
    dy = 1

    ' add the cube graphic
    Set tcGrMesh = tcGrs.Add(imsi3DMesh, "TCW70MESH")

    ' add points as verices that will define the box
    Set tcVrtsMesh = tcGrMesh.Vertices

    x = 0
    y = 0
    z = 0

    Randomize
    With tcVrtsMesh
        for indY = 0 to cy
            for indX = 0 to cx
                .Add x, y, z, true, true, true, true
                z = 0 '21 * Rnd - 10
                x = x + dx
            next
            x = 0
            y = y + dy
        next
    End With

    tcGrMesh.Draw
    'DumpProps tcPropsMesh

    Set tcPropsMesh = Nothing
    Set tcVrtsMesh = Nothing
    Set tcGrMesh = Nothing

End Sub

Sub CreateCube()

Dim tcGrCube
Dim tcPropsCube
Dim tcVrtsCube

    ' add the cube graphic
    Set tcGrCube = tcGrs.Add(, "TCW40CUBE")

   ' it is need to set property to make correct graphic
    Set tcPropsCube = tcGrCube.Properties
    with tcPropsCube
        .Item("Solid") = bSolid
    end with

    ' add points as verices that will define the box
    Set tcVrtsCube = tcGrCube.Vertices
    With tcVrtsCube
        .Add 1, 1, 0
        .Add 2, 1, 0
        .Add 1, 2, 0
        .Add 1, 2, 1
    End With

    tcGrCube.Draw
    DumpProps tcPropsCube

    Set tcPropsCube = Nothing
    Set tcVrtsCube = Nothing
    Set tcGrCube = Nothing

End Sub

Sub CreateCone()

Dim tcGrCone
Dim tcGrsCone
Dim tcPropsCone
Dim tcGr1
Dim tcGr2
Dim tcVrts

    ' create the circle graphic that will be
    ' a profile (base) for Cone
    Set tcGr1 = tcGrs.AddCircleCenterAndPoint(1, 1, 0, 2, 2, 0)

   ' add the point graphic
   ' that will be vertex of cone
    Set tcGr2 = tcGrs.Add(imsiPolyline)
    tcGr2.Vertices.Add 1, 1, 4

   ' add the graphic of type TCW40LOFT
   ' that will be a Cone
    Set tcGrCone = tcGrs.Add(, "TCW40LOFT")

   ' it is need to set property to make correct graphic
    Set tcPropsCone = tcGrCone.Properties
    with tcPropsCone
        .Item("Solid") = bSolid
        .Item("$SMOOTH") = 0
    end with

   ' add the point as vertex that
   ' that will be a projection vertex
   ' of cone on base graphic plane
    tcGrCone.Vertices.Add 1, 1, 0

   ' add the profile grahics to graphics collection of cone
    Set tcGrsCone = tcGrCone.Graphics
    tcGrs.Remove(tcGr1.Index)    ' *
    tcGrs.Remove(tcGr2.Index)    ' *

    with tcGrsCone
        .AddGraphic tcGr1
        .AddGraphic tcGr2
    end with

    tcGrCone.Draw
    DumpProps tcPropsCone

    Set tcGr1 = Nothing
    Set tcGr2 = Nothing

    Set tcGrsCone = Nothing
    Set tcPropsCone = Nothing
    Set tcGrCone = Nothing

End Sub

Public Sub CreatePrizm()

Dim tcGrPrizm
Dim tcGrsPrizm
Dim tcPropsPrizm
Dim tcGr1
Dim tcGr2

   ' create the graphic that will be profile
   ' (first base) for Prizm
   Set tcGr1 = tcGrs.AddLineRectangle(1, 1, 0, 2, 2, 0)

   ' create the graphic that will be profile
   ' (second base) for Prizm
   Set tcGr2 = tcGrs.AddLineRectangle(1.2, 1.2, 0, 1.8, 1.8, 0)
   tcGr2.MoveRelative 0, 0, 2

   ' add the graphic of type TCW40LOFT
   ' that will be a Prizm
   Set tcGrPrizm = tcGrs.Add(, "TCW40LOFT")

   ' it is need to set properties to make correct graphic
    Set tcPropsPrizm = tcGrPrizm.Properties
    With tcPropsPrizm
       .Item("Solid") = bSolid
       .Item("$SMOOTH") = 0
    End With

   ' add the profile grahics to graphics collection of Prizm
    tcGrs.Remove(tcGr1.Index)   ' *
    tcGrs.Remove(tcGr2.Index)   ' *

    Set tcGrsPrizm = tcGrPrizm.Graphics
    With tcGrsPrizm
        .AddGraphic tcGr1
        .AddGraphic tcGr2
    End With

    '? To avoid one bug we now have in TurboCAD
    '? for prizm we should add and them remove a one vertex

    '? Set Ver = Gr.Vertices.Add(0, 0, 0)
    '? Set Ver = Gr.Vertices.Remove(0)

    tcGrPrizm.Draw
    DumpProps tcPropsPrizm

    Set tcGr1 = Nothing
    Set tcGr2 = Nothing

    Set tcGrsPrizm = Nothing
    Set tcPropsPrizm = Nothing
    Set tcGrPrizm = Nothing

End Sub

Sub CreateNormalExtrusion()

Dim tcGrExtrusion
Dim tcPropsExtrusion
Dim tcVrtsExtrusion

Dim tcGr1

    ' create the graphic that will be profile
    ' (base) for Extrusion
    Set tcGr1 = tcGrs.AddLineRectangle(1, 1, 0, 2, 2, 0)

    ' add the graphic of type TCW40EXTRUDE
    ' that will be Extrusion
    Set tcGrExtrusion = tcGrs.Add(, "TCW40EXTRUDE")

   ' it is need to set properties to make correct graphic
    Set tcPropsExtrusion = tcGrExtrusion.Properties
    With tcPropsExtrusion
        .Item("Solid") = bSolid
        .Item("$PIPE") = 1
'       .Item("$APPROCSIMCURVE") = 19
    End With

    ' add the base grahic to graphics collection of Extrusion
    tcGrs.Remove tcGr1.Index ' *
    tcGrExtrusion.Graphics.AddGraphic tcGr1

   ' add points as Vertices to the Extrusionc
   ' to define extrusion path (segment of extrude)
   ' **
   Set tcVrtsExtrusion = tcGrExtrusion.Vertices
   tcVrtsExtrusion.UseWorldCS = True
   With tcVrtsExtrusion
      .Add 1, 1, 0
      .Add 1, 1, 3
   End With

   tcGrExtrusion.Draw
   DumpProps tcPropsExtrusion

   Set tcGr1 = Nothing

   Set tcPropsExtrusion = Nothing
   Set tcVrtsExtrusion = Nothing
   Set tcGrExtrusion = Nothing

End Sub

Sub CreateRigidExtrusion()

Dim x
Dim y
Dim z

Dim tcGrExtrusion
Dim tcPropsExtrusion
Dim tcVrtsExtrusion

Dim tcGr1

    ' create the graphic that will be profile
    ' (base) for extrude
    Set tcGr1 = tcGrs.AddLineRectangle(1, 1, 0, 2, 2, 0)

    ' add the graphic of type TCW40EXTRUDE
    ' that will be Extrusion
    Set tcGrExtrusion = tcGrs.Add(, "TCW40EXTRUDE")

   ' it is need to set properties to make correct graphic
    Set tcPropsExtrusion = tcGrExtrusion.Properties
    With tcPropsExtrusion
        .Item("Solid") = bSolid
        .Item("$PIPE") = 0
'       .Item("$APPROCSIMCURVE") = 19
    End With

    ' add the base grahic to graphics collection of Extrusion
    tcGrs.Remove tcGr1.Index ' *
    tcGrExtrusion.Graphics.AddGraphic tcGr1

   ' add points as Vertices to the Extrusionc
   ' to define extrusion path (segment of extrude)
   ' **
   Set tcVrtsExtrusion = tcGrExtrusion.Vertices
   tcVrtsExtrusion.UseWorldCS = True

   x = 1.5
   y = 1.5
   z = 0

   With tcVrtsExtrusion

       .Add x, y, z
       x = x + 1
       z = z + 1
       .Add x, y, z
       y = y + 1
       .Add x, y, z
       z = z + 1
       .Add x, y, z

   End With

   tcGrExtrusion.Draw
   DumpProps tcPropsExtrusion
   Set tcGr1 = Nothing

   Set tcPropsExtrusion = Nothing
   Set tcVrtsExtrusion = Nothing
   Set tcGrExtrusion = Nothing

End Sub

Sub CreateHemiSphere()

Dim tcGrHemiSphere
Dim tcPropsHemiSphere
Dim tcVrtsHemiSphere

    ' add the graphic of type TCW40SPHERE
    ' that will be HemiSphere
    Set tcGrHemiSphere = tcGrs.Add(, "TCW40SPHERE")

   ' it is need to set properties to make correct graphic
    Set tcPropsHemiSphere = tcGrHemiSphere.Properties
    With tcPropsHemiSphere
       .Item("Solid") = bSolid
       .Item("$HEMISPHERE") = 1
'      .Item("$MERIDIANDENSITY") = 45
'      .Item("$PARALLELDENSITY") = 67
'      .Item("$SMOOTH") = 1
    End With

    Set tcVrtsHemiSphere = tcGrHemiSphere.Vertices
    With tcVrtsHemiSphere
        .Add 1, 1, 1
        .Add -1, -1, 1
    End With

    tcGrHemiSphere.Draw
    DumpProps tcPropsHemiSphere

    Set tcVrtsHemiSphere = Nothing
    Set tcPropsHemiSphere = Nothing

    Set tcGrHemiSphere = Nothing

End Sub

Sub CreateSphere()

Dim tcGrSphere
Dim tcPropsSphere
Dim tcVrtsSphere

    ' add the graphic of type TCW40SPHERE
    ' that will be Sphere
    Set tcGrSphere = tcGrs.Add(, "TCW40SPHERE")

   ' it is need to set properties to make correct graphic
    Set tcPropsSphere = tcGrSphere.Properties
    With tcPropsSphere
       .Item("Solid") = bSolid
       .Item("$HEMISPHERE") = 0
'      .Item("$MERIDIANDENSITY") = 45
'      .Item("$PARALLELDENSITY") = 67
'      .Item("$SMOOTH") = 1
    End With

    Set tcVrtsSphere = tcGrSphere.Vertices
    With tcVrtsSphere
        .Add 1, 1, 1
        .Add -1, -1, 1
    End With

    tcGrSphere.Draw
    DumpProps tcPropsSphere

    Set tcVrtsSphere = Nothing
    Set tcPropsSphere = Nothing

    Set tcGrSphere = Nothing

End Sub

Sub CreateRevolve()

Dim tcGrRevolve
Dim tcPropsRevolve
Dim tcVrtsRevolve

Dim tcGr1

    ' create the graphic that will be profile
    ' (base) for Revolve
    Set tcGr1 = tcGrs.AddLineSingle(0, 0, 0, 0.5, 0, 0)
    tcGr1.Vertices.Add 0.5, 0.5, 0
    tcGr1.Close

    ' create graphic of type TCW40SPIN
    ' that will be Revolve
    Set tcGrRevolve = tcGrs.Add(, "TCW40SPIN")

    ' it is need to set properties to make correct graphic
    Set tcPropsRevolve = tcGrRevolve.Properties
    With tcPropsRevolve
       .Item("Solid") = bSolid
' ?    .Item("$ROTATIONANGLE") = 90
       .Item("$ROTATIONANGLE") = 360
       .Item("$SPIRENUMBER") = 5
       .Item("$STEP") = 1
'      .Item("$APPROCSIMCURVE") = 56
'      .Item("$SMOOTH") = 1
    End with

   ' add the base grahic to graphics collection of Revolve
    tcGrs.Remove tcGr1.Index ' "
    tcGrRevolve.Graphics.AddGraphic tcGr1

    ' add two points to the define Revolve axis
    Set tcVrtsRevolve = tcGrRevolve.Vertices
    tcVrtsRevolve.UseWorldCS = True
    With tcVrtsRevolve
        .Add 1, 1, 0
        .Add 1, 2, 0
    End With

    tcGrRevolve.Draw
    DumpProps tcPropsRevolve

    Set tcGr1 = Nothing

    Set tcPropsRevolve = Nothing
    Set tcVrtsRevolve  = Nothing
    Set tcGrRevolve    = Nothing

End Sub

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set tcApp = CreateObject("TurboCAD.Application")
    rootPath = tcApp.Path

    bSolid = False
    Set tcDwgs = tcApp.Drawings

    if (tcDwgs.Count > 0) then

        Set tcDwg = tcApp.ActiveDrawing
        Set tcVw = tcDwg.ActiveView
        Set tcGrs = tcDwg.Graphics

        CreateCube
        CreateCone
        CreatePrizm
        CreateNormalExtrusion
        CreateRigidExtrusion
        CreateHemiSphere
        CreateSphere
        CreateRevolve

        tcVw.ZoomToExtents
    end if

    MsgBox "Done"

    Set tcDwgs = Nothing
    Set tcApp = Nothing

'******************** Notes *******************************************
'
' * - it is need to remove the Graphic Object from Graphics collection
'     before add to another because Graphic Object can't belongs 2 different
'      Graphics Colloections
'
' ** - extrusion path will be automaticalle recalculated and vill be centered
'      relatively to geometric center of the base extrusion profile
'
'
'==============================================
' TCW40CUBE
'==============================================
' Material				3D Page, Material
' Solid					3D Page, Solid/Surface

' $ACISCOSMETIC			Not used

'==============================================
' TCW40LOFT
'==============================================
' Material				3D Page, Material
' Solid					3D Page, Solid/Surface

' $ACISCOSMETIC			Not used
' $SOLID				Not used

' $APPROCSIMCURVE		Lofting Shape Page, Number of approximation lines
' $SMOOTH				Lofting Shape Page, Smooth
' $MINTWIST				Lofting Shape Page, Minimize Twist

'==============================================
' TCW40EXTRUDE
'==============================================
' Material				3D Page, Material
' Solid					3D Page, Solid/Surface

' $ACISCOSMETIC			Not used
' $SOLID				Not used

' $PIPE					Local Menu option,  Normal Path
' $APPROCSIMCURVE		Extrude Shape Page, Number of approximation lines
' $SMOOTH				Extrude Shape Page, Smooth
' $TWISTANGLE			Extrude Shape Page, Twist Angle (degrees in UI, but radians for programming)

'==============================================
' "TCW40SPHERE"
'==============================================
'
' Material				3D Page, Material
' Solid					3D Page, Solid/Surface
'
' $ACISCOSMETIC			not used
'
' $HEMISPHERE			Sphere tool/Hemisphere tool
'
' $PARALLELDENSITY		Sphere Page, Number of latitudinal segments
' $MERIDIANDENSITY		Sphere Page, Number of longitudinal segments
' $SMOOTH 				Sphere Page, Smooth

'==============================================
' TCW40SPIN
'==============================================
' Material				3D Page, Material
' Solid					3D Page, Solid/Surface
'
' $ACISCOSMETIC			not used
' $SPIRENUMBER			not used

' $ROTATIONCOPY			Sections per spiral coil
' $APPROCSIMCURVE		Number of approximation lines
' $ROTATIONANGLE		Angle of rotation (degrees in UI, but radians for programming)
' $SMOOTH				Smooth
' $STEP					Spiral pitch
' $HANDINESS			Counterclockwise/Clockwise
' $COILNUMBER			Number of coils


Examples - C++ Events - EVENTDLG.CPP

EVENTDLG.CPP

C++ Events Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// EventDlg.cpp : implementation file
//

#include "stdafx.h"
#include "Events.h"
#include "EventDlg.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

extern CTCEventsApp theApp;

static void DDX_EventMask(CDataExchange* pDX, UINT nIDCFirst, UINT nIDCLast, DWORD& value)
{
    HWND hWndDlg = pDX->m_pDlgWnd->m_hWnd;
    DWORD dwBit = 1;
    UINT nID;
    HWND hWndButton;
    if (pDX->m_bSaveAndValidate)
    {
        value = 0;
        for (nID = nIDCFirst; nID <= nIDCLast; ++nID, dwBit <<= 1)
        {
            hWndButton = ::GetDlgItem(hWndDlg, nID);
            if (::SendMessage(hWndButton, BM_GETCHECK, 0, 0) != 0)
                value |= dwBit;
        }
    }
    else
    {
        for (nID = nIDCFirst; nID <= nIDCLast; ++nID, dwBit <<= 1)
        {
            hWndButton = ::GetDlgItem(hWndDlg, nID);
            ::SendMessage(hWndButton, BM_SETCHECK, (value & dwBit) ? 1 : 0, 0);
        }
    }
}

/////////////////////////////////////////////////////////////////////////////
// CAboutDlg dialog used for App About

class CAboutDlg : public CDialog
{
public:
    CAboutDlg();

// Dialog Data
    //{{AFX_DATA(CAboutDlg)
    enum { IDD = IDD_ABOUTBOX };
    //}}AFX_DATA

    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CAboutDlg)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:
    //{{AFX_MSG(CAboutDlg)
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

CAboutDlg::CAboutDlg() : CDialog(CAboutDlg::IDD)
{
    //{{AFX_DATA_INIT(CAboutDlg)
    //}}AFX_DATA_INIT
}

void CAboutDlg::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CAboutDlg)
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CAboutDlg, CDialog)
    //{{AFX_MSG_MAP(CAboutDlg)
        // No message handlers
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CTCEventsDlg dialog

CTCEventsDlg::CTCEventsDlg(CWnd* pParent /*=NULL*/)
    : CDialog(CTCEventsDlg::IDD, pParent),
    m_dwEventConnection(0),
    m_dwEventMask(~0UL),
    m_pIApplication(NULL)
{
    //{{AFX_DATA_INIT(CTCEventsDlg)
    //}}AFX_DATA_INIT
    // Note that LoadIcon does not require a subsequent DestroyIcon in Win32
    m_hIcon = AfxGetApp()->LoadIcon(IDR_MAINFRAME);
}

// TurboCAD SDK: make sure we release the application
CTCEventsDlg::~CTCEventsDlg()
{
    ReleaseApp();
}

void CTCEventsDlg::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CTCEventsDlg)
    //}}AFX_DATA_MAP
    DDX_EventMask(pDX, IDC_EVENT1, IDC_EVENT28, m_dwEventMask);
}

// Public function to allow event hander to post a message on our edit box

void CTCEventsDlg::AppendText(LPCTSTR lpszText)
{
    int nStart, nEnd;
    m_edit.SetSel(0, -1);
    m_edit.GetSel(nStart, nEnd);
    if (nEnd > 4000)
    {
        // Dump the buffer if it's too big
        Clear();
        nEnd = 0;
    }
    m_edit.SetSel(nEnd, nEnd);
    m_edit.ReplaceSel(lpszText);
}

// Clear our edit box

void CTCEventsDlg::Clear()
{
    m_edit.SetSel(0, -1);
    m_edit.Clear();
}

// Create an instance of the TurboCAD local server object

IUnknown* CTCEventsDlg::CreateLocalServerObject()
{
    // Try to create instance from TurboCAD
    IUnknown* pUnk = NULL;
    HRESULT hRes = ::CoCreateInstance(CLSID_Application, NULL,
        CLSCTX_LOCAL_SERVER, IID_IUnknown, (void**)&pUnk);
    if (FAILED(hRes))
    {
        AfxMessageBox("Could not create application object!");
        return NULL;
    }
    return pUnk;
}

// Get the running instance of the TurboCAD local server object from the ROT.

IUnknown* CTCEventsDlg::GetActiveObject(BOOL* pbCreateInstance)
{
    // Try to connect to running TurboCAD
    IUnknown* pUnk = NULL;
    HRESULT hRes = ::GetActiveObject(CLSID_Application, NULL, &pUnk);
    if (SUCCEEDED(hRes))
    {
        // Did not create instance
        *pbCreateInstance = FALSE;
        return pUnk;
    }
    if (!*pbCreateInstance)
    {
        AfxMessageBox("TurboCAD is not active!");
        return NULL;
    }
    return CreateLocalServerObject();
}

// Release our pointers

void CTCEventsDlg::ReleaseApp()
{
    DisconnectEvents();
    if (m_pIApplication != NULL)
    {
        m_pIApplication->Release();
        m_pIApplication = NULL;
    }
}

// Connect our app's event sink to the TurboCAD server.
// Connect or start up the TurboCAD server if we need to.

void CTCEventsDlg::ConnectEvents()
{
    if (m_dwEventConnection != 0)
    {
        AfxMessageBox("Already connected.");
        return;
    }
    if (m_pIApplication == NULL)
    {
        BOOL bCreateInstance = TRUE;
        IUnknown* pUnk = GetActiveObject(&bCreateInstance);
        if (pUnk == NULL)
            return;

        HRESULT hRes = pUnk->QueryInterface(IID_IApplication, (void**)&m_pIApplication);
        pUnk->Release();
        if (FAILED(hRes))
        {
            AfxMessageBox("Object is not a TurboCAD application!");
            return;
        }
        else
        {
            if (bCreateInstance)
                AfxMessageBox("Created new Application object.");
            else
                AfxMessageBox("Attached to already running Application object.");
            GetDlgItem(IDC_EXIT_APP)->EnableWindow(TRUE);
        }
    }

    IDispatch* pUnkEventSink = theApp.GetIDispatch(TRUE);

    UpdateData(TRUE);
    COleVariant var((long)m_dwEventMask);
    HRESULT hRes = m_pIApplication->ConnectEvents(pUnkEventSink,
        &var,
        (long*)&m_dwEventConnection);
    if (FAILED(hRes))
    {
        AfxMessageBox("Connection not established.");
        return;
    }
    else
    {
        TCHAR msg[256];
        wsprintf(msg, "Connection established (mask = 0x%08lx).", m_dwEventMask);
        AfxMessageBox(msg);
    }

    CString strButtonText;
    strButtonText.LoadString(IDS_DISCONNECT);
    GetDlgItem(IDC_CONNECT_EVENTS)->SetWindowText(strButtonText);
}

// Release the event connection

void CTCEventsDlg::DisconnectEvents()
{
    if (m_pIApplication == NULL || m_dwEventConnection == 0)
        return;

     HRESULT hRes = m_pIApplication->DisconnectEvents(m_dwEventConnection);
    if (FAILED(hRes))
    {
        AfxMessageBox("Connection not broken.");
        return;
    }

    AfxMessageBox("Connection broken.");
    m_dwEventConnection = 0;

    // DisconnectEvents can be called from destructor after DestroyWindow()...
    if (::IsWindow(m_hWnd))
    {
        CString strButtonText;
        strButtonText.LoadString(IDS_CONNECT);
        GetDlgItem(IDC_CONNECT_EVENTS)->SetWindowText(strButtonText);
    }
}

BEGIN_MESSAGE_MAP(CTCEventsDlg, CDialog)
    //{{AFX_MSG_MAP(CTCEventsDlg)
    ON_WM_SYSCOMMAND()
    ON_WM_PAINT()
    ON_WM_QUERYDRAGICON()
    ON_BN_CLICKED(IDC_CONNECT_EVENTS, OnConnectEvents)
    ON_BN_CLICKED(IDC_EXIT_APP, OnExitApp)
    //}}AFX_MSG_MAP
    ON_CONTROL_RANGE(BN_CLICKED, IDC_EVENT1, IDC_EVENT28, OnEventMask)
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CTCEventsDlg message handlers

// TurboCAD SDK: TurboCAD Class Identifier and Interface Identifier
const CLSID CLSID_Application  = {0x6A481001,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const CLSID CLSID_XApplication = {0x6A481801,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_IApplication = {0x6A481101,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

BOOL CTCEventsDlg::OnInitDialog()
{
    CDialog::OnInitDialog();

    // Add "About..." menu item to system menu.

    // IDM_ABOUTBOX must be in the system command range.
    ASSERT((IDM_ABOUTBOX & 0xFFF0) == IDM_ABOUTBOX);
    ASSERT(IDM_ABOUTBOX < 0xF000);

    CMenu* pSysMenu = GetSystemMenu(FALSE);
    CString strAboutMenu;
    strAboutMenu.LoadString(IDS_ABOUTBOX);
    if (!strAboutMenu.IsEmpty())
    {
        pSysMenu->AppendMenu(MF_SEPARATOR);
        pSysMenu->AppendMenu(MF_STRING, IDM_ABOUTBOX, strAboutMenu);
    }

    // Set the icon for this dialog.  The framework does this automatically
    //  when the application's main window is not a dialog
    SetIcon(m_hIcon, TRUE);			// Set big icon
    SetIcon(m_hIcon, FALSE);		// Set small icon

    // Enable the buttons
    GetDlgItem(IDC_CONNECT_EVENTS)->EnableWindow(TRUE);
    GetDlgItem(IDC_EXIT_APP)->EnableWindow(FALSE);

    m_edit.SubclassDlgItem(IDC_EDIT_LOG, this);

    return TRUE;  // return TRUE  unless you set the focus to a control
}

void CTCEventsDlg::OnSysCommand(UINT nID, LPARAM lParam)
{
    if ((nID & 0xFFF0) == IDM_ABOUTBOX)
    {
        CAboutDlg dlgAbout;
        dlgAbout.DoModal();
    }
    else
    {
        CDialog::OnSysCommand(nID, lParam);
    }
}

// If you add a minimize button to your dialog, you will need the code below
//  to draw the icon.  For MFC applications using the document/view model,
//  this is automatically done for you by the framework.

void CTCEventsDlg::OnPaint()
{
    if (IsIconic())
    {
        CPaintDC dc(this); // device context for painting

        SendMessage(WM_ICONERASEBKGND, (WPARAM) dc.GetSafeHdc(), 0);

        // Center icon in client rectangle
        int cxIcon = GetSystemMetrics(SM_CXICON);
        int cyIcon = GetSystemMetrics(SM_CYICON);
        CRect rect;
        GetClientRect(&rect);
        int x = (rect.Width() - cxIcon + 1) / 2;
        int y = (rect.Height() - cyIcon + 1) / 2;

        // Draw the icon
        dc.DrawIcon(x, y, m_hIcon);
    }
    else
    {
        CDialog::OnPaint();
    }
}

// The system calls this to obtain the cursor to display while the user drags
//  the minimized window.
HCURSOR CTCEventsDlg::OnQueryDragIcon()
{
    return (HCURSOR) m_hIcon;
}

void CTCEventsDlg::OnConnectEvents()
{
    if (m_dwEventConnection == 0)
    {
        ConnectEvents();
    }
    else
    {
        DisconnectEvents();
    }
}

void CTCEventsDlg::OnExitApp()
{
    if (m_pIApplication == NULL)
    {
        AfxMessageBox("Start application first.");
        return;
    }
    DisconnectEvents();
    m_pIApplication->Quit();
    ReleaseApp();
    GetDlgItem(IDC_EXIT_APP)->EnableWindow(FALSE);
}

void CTCEventsDlg::OnEventMask(UINT nIDC)
{
    // Change the connection if we're connected...
    if (m_dwEventConnection != 0)
    {
        DisconnectEvents();
        ConnectEvents();
    }
}


Examples - C++ Events - EVENTDLG.H

EVENTDLG.H

C++ Events Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// EventDlg.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CTCEventsDlg dialog

class CTCEventsDlg : public CDialog
{
// Construction
public:
    CTCEventsDlg(CWnd* pParent = NULL);	// standard constructor
    ~CTCEventsDlg(); // TurboCAD SDK: make sure we release the application

// Dialog Data
    //{{AFX_DATA(CTCEventsDlg)
    enum { IDD = IDD_EVENTS_DIALOG };
    //}}AFX_DATA

    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CTCEventsDlg)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);	// DDX/DDV support
    //}}AFX_VIRTUAL

// Operations
public:
    void AppendText(LPCTSTR lpszText);
    void Clear();

// Implementation
protected:
    HICON m_hIcon;
    CEdit m_edit;

    // TurboCAD SDK:  Pointer to the running application.
    IApplication* m_pIApplication;
    DWORD m_dwEventConnection;
    DWORD m_dwEventMask;

    IUnknown* CreateLocalServerObject();
    IUnknown* GetActiveObject(BOOL* pbCreateInstance);
    void ReleaseApp();
    void ConnectEvents();
    void DisconnectEvents();

    // Generated message map functions
    //{{AFX_MSG(CTCEventsDlg)
    virtual BOOL OnInitDialog();
    afx_msg void OnSysCommand(UINT nID, LPARAM lParam);
    afx_msg void OnPaint();
    afx_msg HCURSOR OnQueryDragIcon();
    afx_msg void OnConnectEvents();
    afx_msg void OnExitApp();
    afx_msg void OnClearResults();
    //}}AFX_MSG
    afx_msg void OnEventMask(UINT nID);
    DECLARE_MESSAGE_MAP()
};


Examples - C++ Events - EVENTS.CPP

EVENTS.CPP

C++ Events Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// TCEvents.cpp : Defines the class behaviors for the application.
//

#include "stdafx.h"
#include "Events.h"
#include "EventDlg.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

// Some IIDs from imsigx.i_c
const IID LIBID_IMSIGXLib = {0x6A481400,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_PickResult = {0x6A481123,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_Tool = {0x6A48112C,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

////////////////////////////////////////////////////////////////////////////
// CTCEventsApp

BEGIN_MESSAGE_MAP(CTCEventsApp, CWinApp)
    //{{AFX_MSG_MAP(CTCEventsApp)
        // NOTE - the ClassWizard will add and remove mapping macros here.
        //    DO NOT EDIT what you see in these blocks of generated code!
    //}}AFX_MSG
    ON_COMMAND(ID_HELP, CWinApp::OnHelp)
END_MESSAGE_MAP()

BEGIN_DISPATCH_MAP(CTCEventsApp, CWinApp)
    //{{AFX_DISPATCH_MAP(CTCEventsApp)
    DISP_FUNCTION(CTCEventsApp, "BeforeExit", BeforeExit, VT_EMPTY, VTS_DISPATCH VTS_PBOOL)
    DISP_FUNCTION(CTCEventsApp, "DrawingNew", DrawingNew, VT_EMPTY, VTS_DISPATCH)
    DISP_FUNCTION(CTCEventsApp, "DrawingOpen", DrawingOpen, VT_EMPTY, VTS_DISPATCH)
    DISP_FUNCTION(CTCEventsApp, "DrawingActivate", DrawingActivate, VT_EMPTY, VTS_DISPATCH)
    DISP_FUNCTION(CTCEventsApp, "DrawingDeactivate", DrawingDeactivate, VT_EMPTY, VTS_DISPATCH)
    DISP_FUNCTION(CTCEventsApp, "DrawingBeforeClose", DrawingBeforeClose, VT_EMPTY, VTS_DISPATCH VTS_PBOOL)
    DISP_FUNCTION(CTCEventsApp, "DrawingBeforeSave", DrawingBeforeSave, VT_EMPTY, VTS_DISPATCH VTS_PBOOL VTS_PBOOL)
    DISP_FUNCTION(CTCEventsApp, "DrawingAfterSave", DrawingAfterSave, VT_EMPTY, VTS_DISPATCH)
    DISP_FUNCTION(CTCEventsApp, "WindowResize", WindowResize, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH)
    DISP_FUNCTION(CTCEventsApp, "WindowActivate", WindowActivate, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH)
    DISP_FUNCTION(CTCEventsApp, "WindowDeactivate", WindowDeactivate, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH)
    DISP_FUNCTION(CTCEventsApp, "MouseDown", MouseDown, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_I2 VTS_I4 VTS_I4 VTS_I4 VTS_PBOOL)
    DISP_FUNCTION(CTCEventsApp, "MouseUp", MouseUp, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_I2 VTS_I4 VTS_I4 VTS_I4 VTS_PBOOL)
    DISP_FUNCTION(CTCEventsApp, "MouseMove", MouseMove, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_I4 VTS_I4 VTS_I4 VTS_PBOOL)
    DISP_FUNCTION(CTCEventsApp, "BeforeDoubleClick", BeforeDoubleClick, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_PBOOL)
    DISP_FUNCTION(CTCEventsApp, "BeforeRightClick", BeforeRightClick, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_PBOOL)
    DISP_FUNCTION(CTCEventsApp, "SelectionChange", SelectionChange, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH)
    DISP_FUNCTION(CTCEventsApp, "CommandBarControlHit", CommandBarControlHit, VT_EMPTY, VTS_DISPATCH VTS_PBOOL)
    DISP_FUNCTION(CTCEventsApp, "CommandBarControlStatus", CommandBarControlStatus, VT_EMPTY, VTS_DISPATCH)
    DISP_FUNCTION(CTCEventsApp, "RunTool", RunTool, VT_EMPTY, VTS_DISPATCH)
    DISP_FUNCTION(CTCEventsApp, "PointSnapped", PointSnapped, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_I4 VTS_I4 VTS_DISPATCH VTS_DISPATCH)
    DISP_FUNCTION(CTCEventsApp, "PointPick", PointPick, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_BOOL)
    DISP_FUNCTION(CTCEventsApp, "RectanglePick", RectanglePick, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_BOOL)
    DISP_FUNCTION(CTCEventsApp, "PolygonPick", PolygonPick, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_BOOL)
    DISP_FUNCTION(CTCEventsApp, "ViewBeforeRedraw", ViewBeforeRedraw, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH)
    DISP_FUNCTION(CTCEventsApp, "ViewAfterRedraw", ViewAfterRedraw, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH)
    DISP_FUNCTION(CTCEventsApp, "VirtualIntersectionPick", VirtualIntersectionPick, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_BOOL)
    DISP_FUNCTION(CTCEventsApp, "CommandBarControlDone", CommandBarControlDone, VT_EMPTY, VTS_DISPATCH)
    DISP_FUNCTION(CTCEventsApp, "Drop", Drop, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH)
    //}}AFX_DISPATCH_MAP
END_DISPATCH_MAP()

// Note: we add support for IID_IAppEvents to support typesafe binding
//  from VBA.  This IID must match the GUID that is attached to the
//  dispinterface in the .ODL file.

// {6A481301-E531-11CF-A115-00A024158DAF}
static const IID IID_IAppEvents =
{ 0x6A481301, 0xE531, 0x11CF, { 0xA1, 0x15, 0x0, 0xA0, 0x24, 0x15, 0x8D, 0xAF } };

BEGIN_INTERFACE_MAP(CTCEventsApp, CWinApp)
    INTERFACE_PART(CTCEventsApp, IID_IAppEvents, Dispatch)
END_INTERFACE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CTCEventsApp construction

CTCEventsApp::CTCEventsApp()
{
    // TODO: add construction code here,
    // Place all significant initialization in InitInstance
}

/////////////////////////////////////////////////////////////////////////////
// The one and only CTCEventsApp object

CTCEventsApp theApp;

/////////////////////////////////////////////////////////////////////////////
// CTCEventsApp initialization

BOOL CTCEventsApp::InitInstance()
{
    // Initialize OLE libraries
    if (!AfxOleInit())
    {
        AfxMessageBox(IDP_OLE_INIT_FAILED);
        return FALSE;
    }

    // Standard initialization
    // If you are not using these features and wish to reduce the size
    //  of your final executable, you should remove from the following
    //  the specific initialization routines you do not need.

#ifdef _AFXDLL
    Enable3dControls();			// Call this when using MFC in a shared DLL
#else
    Enable3dControlsStatic();	// Call this when linking to MFC statically
#endif

    // Parse the command line to see if launched as OLE server
    if (RunEmbedded() || RunAutomated())
    {
        // Register all OLE server (factories) as running.  This enables the
        //  OLE libraries to create objects from other applications.
        COleTemplateServer::RegisterAll();

        // Application was run with /Embedding or /Automation.  Don't show the
        //  main window in this case.
        return TRUE;
    }

    // Hook up IDispatch
    EnableAutomation();

    // When a server application is launched stand-alone, it is a good idea
    //  to update the system registry in case it has been damaged.
    COleObjectFactory::UpdateRegistryAll();

    CTCEventsDlg dlg;
    m_pMainWnd = &dlg;
    int nResponse = dlg.DoModal();
    if (nResponse == IDOK)
    {
        // TODO: Place code here to handle when the dialog is
        //  dismissed with OK
    }
    else if (nResponse == IDCANCEL)
    {
        // TODO: Place code here to handle when the dialog is
        //  dismissed with Cancel
    }

    // Since the dialog has been closed, return FALSE so that we exit the
    //  application, rather than start the application's message pump.
    return FALSE;
}

// Let's show some useful information also...
// Run through the pick result object and report what's in it.

static void ShowGraphicInfo(CString& str, PickResult *pres)
{
    if (pres)
    {
        long lCount = 0;
        pres->get_Count(&lCount);
        char* line = str.GetBuffer(2000);
        wsprintf(line, "%ld Graphics:\r\n", lCount);

        for (long l = 0; l < lCount; ++l)
        {
            char sline[30];
            PickEntry *pentry = 0;
            COleVariant vindex(l);
            pres->get_Item(&vindex, &pentry);
            if (pentry)
            {
                IGraphic *pgr;
                pentry->get_Graphic(&pgr);
                if (pgr)
                {
                    ImsiGraphicType type;
                    if (SUCCEEDED(pgr->get_TypeByValue(&type)))
                    {
                        char *unk = "Unknown";
                        char *gname[] = {unk, unk, "Arc","Mesh","Viewport",unk,"Text",
                            unk,unk,unk,unk,"Polyline",unk,unk,"Data","Ole Object",
                            "Extended Data","Insert","Surface"};

                        wsprintf(sline, "  %s\r\n", gname[type]);
                    }
                    pgr->Release();
                }
                pentry->Release();
            }
            strcat(line, sline);
        }
        str.ReleaseBuffer();
    }
}

/////////////////////////////////////////////////////////////////////////////
// CTCEventsApp commands

// All we do on an event is post a string to the edit box on the main dialog.

void CTCEventsApp::BeforeExit(LPDISPATCH TheApp, BOOL FAR* Cancel)
{
    GetDialog()->AppendText("BeforeExit\r\n");
}

void CTCEventsApp::DrawingNew(LPDISPATCH WhichDrawing)
{
    GetDialog()->AppendText("DrawingNew\r\n");
}

void CTCEventsApp::DrawingOpen(LPDISPATCH WhichDrawing)
{
    GetDialog()->AppendText("DrawingOpen\r\n");
}

void CTCEventsApp::DrawingActivate(LPDISPATCH WhichDrawing)
{
    GetDialog()->AppendText("DrawingActivate\r\n");
}

void CTCEventsApp::DrawingDeactivate(LPDISPATCH WhichDrawing)
{
    GetDialog()->AppendText("DrawingDeactivate\r\n");
}

void CTCEventsApp::DrawingBeforeClose(LPDISPATCH WhichDrawing, BOOL FAR* Cancel)
{
    GetDialog()->AppendText("DrawingBeforeClose\r\n");
}

void CTCEventsApp::DrawingBeforeSave(LPDISPATCH WhichDrawing, BOOL FAR* SaveAs, BOOL FAR* Cancel)
{
    GetDialog()->AppendText("DrawingBeforeSave\r\n");
}
void CTCEventsApp::DrawingAfterSave(LPDISPATCH WhichDrawing)
{
    GetDialog()->AppendText("DrawingAfterSave\r\n");
}

void CTCEventsApp::WindowResize(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow)
{
    GetDialog()->AppendText("WindowResize\r\n");
}

void CTCEventsApp::WindowActivate(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow)
{
    GetDialog()->AppendText("WindowActivate\r\n");
}

void CTCEventsApp::WindowDeactivate(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow)
{
    GetDialog()->AppendText("WindowDeactivate\r\n");
}

void CTCEventsApp::MouseDown(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel)
{
    *pbCancel = FALSE;
    GetDialog()->AppendText("MouseDown\r\n");
}

void CTCEventsApp::MouseUp(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel)
{
    *pbCancel = FALSE;
    GetDialog()->AppendText("MouseUp\r\n");
}

void CTCEventsApp::MouseMove(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, long Shift, long X, long Y, IMSI_BOOL* pbCancel)
{
    *pbCancel = FALSE;
    GetDialog()->AppendText("MouseMove\r\n");
}

void CTCEventsApp::BeforeDoubleClick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel, BOOL FAR* Cancel)
{
    GetDialog()->AppendText("BeforeDoubleClick\r\n");
}

void CTCEventsApp::BeforeRightClick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel, BOOL FAR* Cancel)
{
    GetDialog()->AppendText("BeforeRightClick\r\n");
}

void CTCEventsApp::SelectionChange(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel)
{
    GetDialog()->AppendText("SelectionChange\r\n");
}

void CTCEventsApp::CommandBarControlHit(LPDISPATCH WhichControl, BOOL FAR* Cancel)
{
    GetDialog()->AppendText("CommandBarControlHit\r\n");
}

void CTCEventsApp::CommandBarControlStatus(LPDISPATCH WhichControl)
{
    GetDialog()->AppendText("CommandBarControlStatus\r\n");
}

void CTCEventsApp::RunTool(LPDISPATCH WhichTool)
{
    // Report on the name of the tool that's running
    CString toolName;
    if (WhichTool == NULL)
    {
        toolName = "<NULL>";
    }
    else
    {
        Tool* pTool = NULL;
        HRESULT hRes = WhichTool->QueryInterface(IID_Tool, (void**)&pTool);
        if (SUCCEEDED(hRes))
        {
            BSTR name = NULL;
            hRes = pTool->get_CommandName(0, &name);
            if (SUCCEEDED(hRes))
            {
                toolName = name;
                ::SysFreeString(name);
            }
            else
            {
                toolName = "<No Name>";
            }
            pTool->Release();
        }
        else
        {
            toolName = "<No IID_Tool>";
        }
    }
    toolName += "\r\n";

    GetDialog()->AppendText("RunTool: ");
    GetDialog()->AppendText(toolName);
}

void CTCEventsApp::PointSnapped(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, long XScreen, long YScreen, LPDISPATCH PointRaw, LPDISPATCH PointSnapped)
{
    GetDialog()->AppendText("PointSnapped\r\n");
}

void CTCEventsApp::PointPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled)
{
    GetDialog()->AppendText("PointPick\r\n");

    // Let's show some useful information also...
    PickResult* pRes = NULL;
    HRESULT hRes = Result->QueryInterface(IID_PickResult, (void**)&pRes);
    if (pRes != NULL)
    {
        CString str;
        ShowGraphicInfo(str, pRes);
        GetDialog()->AppendText(str);
        pRes->Release();
    }
}

void CTCEventsApp::RectanglePick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled)
{
    GetDialog()->AppendText("RectanglePick\r\n");

    // Let's show some useful information also...
    PickResult* pRes = NULL;
    HRESULT hRes = Result->QueryInterface(IID_PickResult, (void**)&pRes);
    if (pRes != NULL)
    {
        CString str;
        ShowGraphicInfo(str, pRes);
        GetDialog()->AppendText(str);
        pRes->Release();
    }
}

void CTCEventsApp::PolygonPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled)
{
    GetDialog()->AppendText("PolygonPick\r\n");
}

void CTCEventsApp::ViewBeforeRedraw(LPDISPATCH WhichDrawing, LPDISPATCH WhichView)
{
    GetDialog()->AppendText("ViewBeforeRedraw\r\n");
}

void CTCEventsApp::ViewAfterRedraw(LPDISPATCH WhichDrawing, LPDISPATCH WhichView)
{
    GetDialog()->AppendText("ViewAfterRedraw\r\n");
}

void CTCEventsApp::VirtualIntersectionPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Pick, BOOL WasCanceled)
{
    GetDialog()->AppendText("VirtualIntersectionPick\r\n");
}

void CTCEventsApp::CommandBarControlDone(LPDISPATCH WhichControl)
{
    GetDialog()->AppendText("CommandBarControlDone\r\n");
}

void CTCEventsApp::Drop(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel)
{
    GetDialog()->AppendText("Drop\r\n");
}

// DUAL_SUPPORT_START
// The rest of this file is boilerplate dual interface stuff.  We use macros from MfcDual.h
// and just wrap all of our implementation functions in TRY/CATCH blocks.

// delegate standard IDispatch methods to MFC IDispatch implementation
DELEGATE_DUAL_INTERFACE(CTCEventsApp, AppEvents)

// Our method and property functions can generally just
// delegate back to the methods we generated using
// ClassWizard. However, if we set up properties to
// access variables directly, we will need to write the
//  code to get/put the value into the variable.

STDMETHODIMP CTCEventsApp::XAppEvents::BeforeExit(IApplication* TheApp, IMSI_BOOL* Cancel)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        // Need to convert between boolean types
        BOOL bCancel = *Cancel;
        pThis->BeforeExit(TheApp, &bCancel);
        *Cancel = bCancel ? (IMSI_BOOL)-1 : (IMSI_BOOL)0;
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::DrawingNew(IDrawing* WhichDrawing)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->DrawingNew(WhichDrawing);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::DrawingOpen(IDrawing* WhichDrawing)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->DrawingOpen(WhichDrawing);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::DrawingActivate(IDrawing* WhichDrawing)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->DrawingActivate(WhichDrawing);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::DrawingDeactivate(IDrawing* WhichDrawing)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->DrawingDeactivate(WhichDrawing);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::DrawingBeforeClose(IDrawing* WhichDrawing, IMSI_BOOL* Cancel)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        // Need to convert between boolean types
        BOOL bCancel = *Cancel;
        pThis->DrawingBeforeClose(WhichDrawing, &bCancel);
        *Cancel = bCancel ? (IMSI_BOOL)-1 : (IMSI_BOOL)0;
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::DrawingBeforeSave(IDrawing* WhichDrawing, IMSI_BOOL* SaveAs, IMSI_BOOL* Cancel)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        // Need to convert between boolean types
        BOOL bSaveAs = *SaveAs;
        BOOL bCancel = *Cancel;
        pThis->DrawingBeforeSave(WhichDrawing, &bSaveAs, &bCancel);
        *SaveAs = bSaveAs ? (IMSI_BOOL)-1 : (IMSI_BOOL)0;
        *Cancel = bCancel ? (IMSI_BOOL)-1 : (IMSI_BOOL)0;
        return S_OK;
    }
    CATCH_ALL_DUAL
}
STDMETHODIMP CTCEventsApp::XAppEvents::DrawingAfterSave(IDrawing* WhichDrawing)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->DrawingAfterSave(WhichDrawing);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::WindowResize(IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->WindowResize(WhichDrawing, WhichView, WhichWindow);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::WindowActivate(IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->WindowActivate(WhichDrawing, WhichView, WhichWindow);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::WindowDeactivate(IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->WindowDeactivate(WhichDrawing, WhichView, WhichWindow);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::MouseDown(IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, ImsiMouseButton Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->MouseDown(WhichDrawing, WhichView, WhichWindow, Button, Shift, X, Y, pbCancel);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::MouseUp(IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, ImsiMouseButton Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->MouseUp(WhichDrawing, WhichView, WhichWindow, Button, Shift, X, Y, pbCancel);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::MouseMove(IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, long Shift, long X, long Y, IMSI_BOOL* pbCancel)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->MouseMove(WhichDrawing, WhichView, WhichWindow, Shift, X, Y, pbCancel);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::BeforeDoubleClick(IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, Selection* Sel, IMSI_BOOL* Cancel)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        // Need to convert between boolean types
        BOOL bCancel = *Cancel;
        pThis->BeforeDoubleClick(WhichDrawing, WhichView, WhichWindow, Sel, &bCancel);
        *Cancel = bCancel ? (IMSI_BOOL)-1 : (IMSI_BOOL)0;
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::BeforeRightClick(IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, Selection* Sel, IMSI_BOOL* Cancel)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        // Need to convert between boolean types
        BOOL bCancel = *Cancel;
        pThis->BeforeRightClick(WhichDrawing, WhichView, WhichWindow, Sel, &bCancel);
        *Cancel = bCancel ? (IMSI_BOOL)-1 : (IMSI_BOOL)0;
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::SelectionChange(IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, Selection* Sel)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->SelectionChange(WhichDrawing, WhichView, WhichWindow, Sel);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::CommandBarControlHit(CommandBarControl* WhichControl, IMSI_BOOL* Cancel)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        // Need to convert between boolean types
        BOOL bCancel = *Cancel;
        pThis->CommandBarControlHit(WhichControl, &bCancel);
        *Cancel = bCancel ? (IMSI_BOOL)-1 : (IMSI_BOOL)0;
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::CommandBarControlStatus(CommandBarControl* WhichControl)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->CommandBarControlStatus(WhichControl);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::RunTool(Tool* WhichTool)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->RunTool(WhichTool);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::PointSnapped(IDrawing* WhichDrawing, View* WhichView, long XScreen, long YScreen, IVertex* PointRaw, IVertex* PointSnapped)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->PointSnapped(WhichDrawing, WhichView, XScreen, YScreen, PointRaw, PointSnapped);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::PointPick(IDrawing* WhichDrawing, View* WhichView, PickResult* Pick, IMSI_BOOL WasCanceled)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->PointPick(WhichDrawing, WhichView, Pick, WasCanceled);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::RectanglePick(IDrawing* WhichDrawing, View* WhichView, PickResult* Pick, IMSI_BOOL WasCanceled)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->RectanglePick(WhichDrawing, WhichView, Pick, WasCanceled);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::PolygonPick(IDrawing* WhichDrawing, View* WhichView, PickResult* Pick, IMSI_BOOL WasCanceled)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->PolygonPick(WhichDrawing, WhichView, Pick, WasCanceled);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::ViewBeforeRedraw(IDrawing* WhichDrawing, View* WhichView)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->ViewBeforeRedraw(WhichDrawing, WhichView);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::ViewAfterRedraw(IDrawing* WhichDrawing, View* WhichView)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->ViewAfterRedraw(WhichDrawing, WhichView);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::VirtualIntersectionPick(IDrawing* WhichDrawing, View* WhichView, PickResult* Pick, IMSI_BOOL WasCanceled)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->VirtualIntersectionPick(WhichDrawing, WhichView, Pick, WasCanceled);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::CommandBarControlDone(CommandBarControl* WhichControl)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->CommandBarControlDone(WhichControl);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CTCEventsApp::XAppEvents::Drop(IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, Selection* Sel)
{
    METHOD_PROLOGUE(CTCEventsApp, AppEvents)

    TRY_DUAL(IID_IAppEvents)
    {
        pThis->Drop(WhichDrawing, WhichView, WhichWindow, Sel);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

// Implement ISupportErrorInfo to indicate we support the
// OLE Automation error handler.
IMPLEMENT_DUAL_ERRORINFO(CTCEventsApp, IID_IAppEvents)

// DUAL_SUPPORT_END


Examples - C++ Events - EVENTS.H

EVENTS.H

C++ Events Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/

// Events.h : main header file for the EVENTS application
//

#ifndef __AFXWIN_H__
    #error include 'stdafx.h' before including this file for PCH
#endif

#include "resource.h"		// main symbols

class CTCEventsDlg;

/////////////////////////////////////////////////////////////////////////////
// CTCEventsApp:
// See Events.cpp for the implementation of this class
//

class CTCEventsApp : public CWinApp
{
public:
    CTCEventsApp();

    CTCEventsDlg* GetDialog() const { return (CTCEventsDlg*)m_pMainWnd; }

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CTCEventsApp)
    public:
    virtual BOOL InitInstance();
    //}}AFX_VIRTUAL

// Implementation
    //{{AFX_MSG(CTCEventsApp)
        // NOTE - the ClassWizard will add and remove member functions here.
        //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()

    // Generated OLE dispatch map functions
    //{{AFX_DISPATCH(CTCEventsApp)
    afx_msg void BeforeExit(LPDISPATCH TheApp, BOOL FAR* Cancel);
    afx_msg void DrawingNew(LPDISPATCH WhichDrawing);
    afx_msg void DrawingOpen(LPDISPATCH WhichDrawing);
    afx_msg void DrawingActivate(LPDISPATCH WhichDrawing);
    afx_msg void DrawingDeactivate(LPDISPATCH WhichDrawing);
    afx_msg void DrawingBeforeClose(LPDISPATCH WhichDrawing, BOOL FAR* Cancel);
    afx_msg void DrawingBeforeSave(LPDISPATCH WhichDrawing, BOOL FAR* SaveAs, BOOL FAR* Cancel);
    afx_msg void DrawingAfterSave(LPDISPATCH WhichDrawing);
    afx_msg void WindowResize(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow);
    afx_msg void WindowActivate(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow);
    afx_msg void WindowDeactivate(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow);
    afx_msg void MouseDown(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel);
    afx_msg void MouseUp(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel);
    afx_msg void MouseMove(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, long Shift, long X, long Y, IMSI_BOOL* pbCancel);
    afx_msg void BeforeDoubleClick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel, BOOL FAR* Cancel);
    afx_msg void BeforeRightClick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel, BOOL FAR* Cancel);
    afx_msg void SelectionChange(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel);
    afx_msg void CommandBarControlHit(LPDISPATCH WhichControl, BOOL FAR* Cancel);
    afx_msg void CommandBarControlStatus(LPDISPATCH WhichControl);
    afx_msg void RunTool(LPDISPATCH WhichTool);
    afx_msg void PointSnapped(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, long XScreen, long YScreen, LPDISPATCH PointRaw, LPDISPATCH PointSnapped);
    afx_msg void PointPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled);
    afx_msg void RectanglePick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled);
    afx_msg void PolygonPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled);
    afx_msg void ViewBeforeRedraw(LPDISPATCH WhichDrawing, LPDISPATCH WhichView);
    afx_msg void ViewAfterRedraw(LPDISPATCH WhichDrawing, LPDISPATCH WhichView);
    afx_msg void VirtualIntersectionPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH PickResult, BOOL WasCanceled);
    afx_msg void CommandBarControlDone(LPDISPATCH WhichControl);
    afx_msg void Drop(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Selection);
    //}}AFX_DISPATCH
    DECLARE_DISPATCH_MAP()
    DECLARE_INTERFACE_MAP()

    // DUAL_SUPPORT_START
    //    add declaration of AppEvents implementation
    //	  You need one entry here for each entry in the
    //	  interface statement of the ODL, plus the entries for a
    //	  dispatch interface. The BEGIN_DUAL_INTERFACE_PART
    //	  macro in mfcdual.h automatically generates the IDispatch
    //	  entries for you.
    //	  Each entry with the "propput" attribute needs a function
    //    named "put_<property name>". Each entry with the "propget"
    //	  attribute needs a function named "get_<property name>".
    //	  You can pull these function prototypes from the header file
    //	  generated by MKTYPLIB.
    BEGIN_DUAL_INTERFACE_PART(AppEvents, IAppEvents)
    STDMETHOD(BeforeExit)(THIS_ IApplication* TheApp, IMSI_BOOL* Cancel);
    STDMETHOD(DrawingNew)(THIS_ IDrawing* WhichDrawing);
    STDMETHOD(DrawingOpen)(THIS_ IDrawing* WhichDrawing);
    STDMETHOD(DrawingActivate)(THIS_ IDrawing* WhichDrawing);
    STDMETHOD(DrawingDeactivate)(THIS_ IDrawing* WhichDrawing);
    STDMETHOD(DrawingBeforeClose)(THIS_ IDrawing* WhichDrawing, IMSI_BOOL* Cancel);
    STDMETHOD(DrawingBeforeSave)(THIS_ IDrawing* WhichDrawing, IMSI_BOOL* SaveAs, IMSI_BOOL* Cancel);
    STDMETHOD(DrawingAfterSave)(THIS_ IDrawing* WhichDrawing);
    STDMETHOD(WindowResize)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow);
    STDMETHOD(WindowActivate)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow);
    STDMETHOD(WindowDeactivate)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow);
    STDMETHOD(MouseDown)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, ImsiMouseButton Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel);
    STDMETHOD(MouseUp)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, ImsiMouseButton Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel);
    STDMETHOD(MouseMove)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, long Shift, long X, long Y, IMSI_BOOL* pbCancel);
    STDMETHOD(BeforeDoubleClick)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, Selection* Sel, IMSI_BOOL* Cancel);
    STDMETHOD(BeforeRightClick)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, Selection* Sel, IMSI_BOOL* Cancel);
    STDMETHOD(SelectionChange)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, Selection* Sel);
    STDMETHOD(CommandBarControlHit)(THIS_ CommandBarControl* WhichControl, IMSI_BOOL* Cancel);
    STDMETHOD(CommandBarControlStatus)(THIS_ CommandBarControl* WhichControl);
    STDMETHOD(RunTool)(THIS_ Tool* WhichTool);
    STDMETHOD(PointSnapped)(THIS_ IDrawing* WhichDrawing, View* WhichView, long XScreen, long YScreen, IVertex* PointRaw, IVertex* PointSnapped);
    STDMETHOD(PointPick)(THIS_ IDrawing* WhichDrawing, View* WhichView, PickResult* Pick, IMSI_BOOL WasCanceled);
    STDMETHOD(RectanglePick)(THIS_ IDrawing* WhichDrawing, View* WhichView, PickResult* Pick, IMSI_BOOL WasCanceled);
    STDMETHOD(PolygonPick)(THIS_ IDrawing* WhichDrawing, View* WhichView, PickResult* Pick, IMSI_BOOL WasCanceled);
    STDMETHOD(ViewBeforeRedraw)(THIS_ IDrawing* WhichDrawing, View* WhichView);
    STDMETHOD(ViewAfterRedraw)(THIS_ IDrawing* WhichDrawing, View* WhichView);
    STDMETHOD(VirtualIntersectionPick)(THIS_ IDrawing* WhichDrawing, View* WhichView, PickResult* Pick, IMSI_BOOL WasCanceled);
    STDMETHOD(CommandBarControlDone)(THIS_ CommandBarControl* WhichControl);
    STDMETHOD(Drop)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, Selection* Sel);
    END_DUAL_INTERFACE_PART(AppEvents)

    //     add declaration of ISupportErrorInfo implementation
    //     to indicate we support the OLE Automation error object
    DECLARE_DUAL_ERRORINFO()
    // DUAL_SUPPORT_END
};

/////////////////////////////////////////////////////////////////////////////


Examples - C++ Events - Mfcdual.cpp

Mfcdual.cpp

C++ Events Example

// mfcdual.cpp: Helpful functions for adding dual interface support to
//		        MFC applications

// This is a part of the Microsoft Foundation Classes C++ library.
// Copyright (C) 1992-1996 Microsoft Corporation
// All rights reserved.
//
// This source code is only intended as a supplement to the
// Microsoft Foundation Classes Reference and related
// electronic documentation provided with the library.
// See these sources for detailed information regarding the
// Microsoft Foundation Classes product.

#include "stdafx.h"

#include <afxpriv.h>

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// DualHandleException

HRESULT DualHandleException(REFIID riidSource, const CException* pAnyException)
{
    USES_CONVERSION;

    ASSERT_VALID(pAnyException);

    TRACE0("DualHandleException called\n");

    // Set ErrInfo object so that VTLB binding container
    // applications can get rich error information.
    ICreateErrorInfo* pcerrinfo;
    HRESULT hr = CreateErrorInfo(&pcerrinfo);
    if (SUCCEEDED(hr))
    {
        TCHAR   szDescription[256];
        LPCTSTR pszDescription = szDescription;
        GUID    guid = GUID_NULL;
        DWORD   dwHelpContext = 0;
        BSTR    bstrHelpFile = NULL;
        BSTR    bstrSource = NULL;
        if (pAnyException->IsKindOf(RUNTIME_CLASS(COleDispatchException)))
        {
            // specific IDispatch style exception
            COleDispatchException* e = (COleDispatchException*)pAnyException;

            guid = riidSource;
            hr = MAKE_HRESULT(SEVERITY_ERROR, FACILITY_ITF,
                              (e->m_wCode + 0x200));

            pszDescription = e->m_strDescription;
            dwHelpContext = e->m_dwHelpContext;

            // propagate source and help file if present
            // call ::SysAllocString directly so no further exceptions are thrown
            if (!e->m_strHelpFile.IsEmpty())
                bstrHelpFile = ::SysAllocString(T2COLE(e->m_strHelpFile));
            if (!e->m_strSource.IsEmpty())
                bstrSource = ::SysAllocString(T2COLE(e->m_strSource));

        }
        else if (pAnyException->IsKindOf(RUNTIME_CLASS(CMemoryException)))
        {
            // failed memory allocation
            AfxLoadString(AFX_IDP_FAILED_MEMORY_ALLOC, szDescription);
            hr = E_OUTOFMEMORY;
        }
        else
        {
            // other unknown/uncommon error
            AfxLoadString(AFX_IDP_INTERNAL_FAILURE, szDescription);
            hr = E_UNEXPECTED;
        }

        if (bstrHelpFile == NULL && dwHelpContext != 0)
            bstrHelpFile = ::SysAllocString(T2COLE(AfxGetApp()->m_pszHelpFilePath));

        if (bstrSource == NULL)
            bstrSource = ::SysAllocString(T2COLE(AfxGetAppName()));

        // Set up ErrInfo object
        pcerrinfo->SetGUID(guid);
        pcerrinfo->SetDescription(::SysAllocString(T2COLE(pszDescription)));
        pcerrinfo->SetHelpContext(dwHelpContext);
        pcerrinfo->SetHelpFile(bstrHelpFile);
        pcerrinfo->SetSource(bstrSource);

        TRACE("\tSource = %ws\n", bstrSource);
        TRACE("\tDescription = %s\n", pszDescription);
        TRACE("\tHelpContext = %lx\n", dwHelpContext);
        TRACE("\tHelpFile = %ws\n", bstrHelpFile);

        // Set the ErrInfo object for the current thread
        IErrorInfo* perrinfo;
        if (SUCCEEDED(pcerrinfo->QueryInterface(IID_IErrorInfo, (LPVOID*)&perrinfo)))
        {
            SetErrorInfo(0, perrinfo);
            perrinfo->Release();
        }

        pcerrinfo->Release();
    }

    TRACE("DualHandleException returning HRESULT %lx\n", hr);

    return hr;
}


Examples - C++ Events - MFCDUAL.H

MFCDUAL.H

C++ Events Example

// mfcdual.h: Helpful macros for adding dual interface support to
//			  MFC applications

// This is a part of the Microsoft Foundation Classes C++ library.
// Copyright (C) 1992-1996 Microsoft Corporation
// All rights reserved.
//
// This source code is only intended as a supplement to the
// Microsoft Foundation Classes Reference and related
// electronic documentation provided with the library.
// See these sources for detailed information regarding the
// Microsoft Foundation Classes product.

/////////////////////////////////////////////////////////////////////
// BEGIN_DUAL_INTERFACE_PART is just like BEGIN_INTERFACE_PART,
// except that it also adds the IDispatch methods to your class
// declaration.
#define BEGIN_DUAL_INTERFACE_PART(localClass, baseClass) \
    BEGIN_INTERFACE_PART(localClass, baseClass) \
       STDMETHOD(GetTypeInfoCount)(UINT FAR* pctinfo); \
       STDMETHOD(GetTypeInfo)(UINT itinfo, LCID lcid, ITypeInfo FAR* FAR* pptinfo); \
       STDMETHOD(GetIDsOfNames)(REFIID riid, OLECHAR FAR* FAR* rgszNames, UINT cNames, LCID lcid, DISPID FAR* rgdispid); \
       STDMETHOD(Invoke)(DISPID dispidMember, REFIID riid, LCID lcid, WORD wFlags, DISPPARAMS FAR* pdispparams, VARIANT FAR* pvarResult, EXCEPINFO FAR* pexcepinfo, UINT FAR* puArgErr); \

/////////////////////////////////////////////////////////////////////
// END_DUAL_INTERFACE_PART is just like END_INTERFACE_PART. It
// is only added for symmetry...
#define END_DUAL_INTERFACE_PART(localClass) \
    END_INTERFACE_PART(localClass) \

/////////////////////////////////////////////////////////////////////
// DELEGATE_DUAL_INTERFACE expands to define the standard IDispatch
// methods for a dual interface, delegating back to the default
// MFC implementation
#define DELEGATE_DUAL_INTERFACE(objectClass, dualClass) \
    STDMETHODIMP_(ULONG) objectClass::X##dualClass::AddRef() \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        return pThis->ExternalAddRef(); \
    } \
    STDMETHODIMP_(ULONG) objectClass::X##dualClass::Release() \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        return pThis->ExternalRelease(); \
    } \
    STDMETHODIMP objectClass::X##dualClass::QueryInterface( \
        REFIID iid, LPVOID* ppvObj) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        return pThis->ExternalQueryInterface(&iid, ppvObj); \
    } \
    STDMETHODIMP objectClass::X##dualClass::GetTypeInfoCount( \
        UINT FAR* pctinfo) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->GetTypeInfoCount(pctinfo); \
    } \
    STDMETHODIMP objectClass::X##dualClass::GetTypeInfo( \
        UINT itinfo, LCID lcid, ITypeInfo FAR* FAR* pptinfo) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->GetTypeInfo(itinfo, lcid, pptinfo); \
    } \
    STDMETHODIMP objectClass::X##dualClass::GetIDsOfNames( \
        REFIID riid, OLECHAR FAR* FAR* rgszNames, UINT cNames, \
        LCID lcid, DISPID FAR* rgdispid) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->GetIDsOfNames(riid, rgszNames, cNames, \
                                         lcid, rgdispid); \
    } \
    STDMETHODIMP objectClass::X##dualClass::Invoke( \
        DISPID dispidMember, REFIID riid, LCID lcid, WORD wFlags, \
        DISPPARAMS FAR* pdispparams, VARIANT FAR* pvarResult, \
        EXCEPINFO FAR* pexcepinfo, UINT FAR* puArgErr) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->Invoke(dispidMember, riid, lcid, \
                                  wFlags, pdispparams, pvarResult, \
                                  pexcepinfo, puArgErr); \
    } \

/////////////////////////////////////////////////////////////////////
// TRY_DUAL and CATCH_ALL_DUAL are used to provide exception handling
// for your dual interface methods. CATCH_ALL_DUAL takes care of
// returning the appropriate error code.

#define TRY_DUAL(iidSource) \
    HRESULT _hr = S_OK; \
    REFIID  _riidSource = iidSource; \
    TRY \

#define CATCH_ALL_DUAL \
    CATCH(COleException, e) \
    { \
        _hr = e->m_sc; \
    } \
    AND_CATCH_ALL(e) \
    { \
        AFX_MANAGE_STATE(pThis->m_pModuleState); \
        _hr = DualHandleException(_riidSource, e); \
    } \
    END_CATCH_ALL \
    return _hr; \

/////////////////////////////////////////////////////////////////////
// DualHandleException is a helper function used to set the system's
// error object, so that container applications that call through
// VTBLs can retrieve rich error information
HRESULT DualHandleException(REFIID riidSource, const CException* pAnyException);

/////////////////////////////////////////////////////////////////////
// DECLARE_DUAL_ERRORINFO expands to declare the ISupportErrorInfo
// support class. It works together with DUAL_ERRORINFO_PART and
// IMPLEMENT_DUAL_ERRORINFO defined below.
#define DECLARE_DUAL_ERRORINFO() \
    BEGIN_INTERFACE_PART(SupportErrorInfo, ISupportErrorInfo) \
        STDMETHOD(InterfaceSupportsErrorInfo)(THIS_ REFIID riid); \
    END_INTERFACE_PART(SupportErrorInfo) \

/////////////////////////////////////////////////////////////////////
// DUAL_ERRORINFO_PART adds the appropriate entry to the interface map
// for ISupportErrorInfo, if you used DECLARE_DUAL_ERRORINFO.
#define DUAL_ERRORINFO_PART(objectClass) \
    INTERFACE_PART(objectClass, IID_ISupportErrorInfo, SupportErrorInfo) \

/////////////////////////////////////////////////////////////////////
// IMPLEMENT_DUAL_ERRORINFO expands to an implementation of
// ISupportErrorInfo which matches the declaration in
// DECLARE_DUAL_ERRORINFO.
#define IMPLEMENT_DUAL_ERRORINFO(objectClass, riidSource) \
    STDMETHODIMP_(ULONG) objectClass::XSupportErrorInfo::AddRef() \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return pThis->ExternalAddRef(); \
    } \
    STDMETHODIMP_(ULONG) objectClass::XSupportErrorInfo::Release() \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return pThis->ExternalRelease(); \
    } \
    STDMETHODIMP objectClass::XSupportErrorInfo::QueryInterface( \
        REFIID iid, LPVOID* ppvObj) \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return pThis->ExternalQueryInterface(&iid, ppvObj); \
    } \
    STDMETHODIMP objectClass::XSupportErrorInfo::InterfaceSupportsErrorInfo( \
        REFIID iid) \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return (iid == riidSource) ? S_OK : S_FALSE; \
    }

/////////////////////////////////////////////////////////////////////


Examples - C++ LineType - AddProperty.cpp

AddProperty.cpp

C++ LineType Example

// AddProperty.cpp : implementation file
//

#include "stdafx.h"
#include "LTSample.h"
#include "AddProperty.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CAddProperty dialog

CAddProperty::CAddProperty(CWnd* pParent /*=NULL*/)
    : CDialog(CAddProperty::IDD, pParent)
{
    //{{AFX_DATA_INIT(CAddProperty)
    m_cstrName = _T("");
    m_cstrType = _T("");
    m_bReadOnly = FALSE;
    //}}AFX_DATA_INIT
}

void CAddProperty::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CAddProperty)
    DDX_Text(pDX, IDC_NAME, m_cstrName);
    DDX_CBString(pDX, IDC_PROPERTYPE, m_cstrType);
    DDX_Check(pDX, IDC_READONLY, m_bReadOnly);
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CAddProperty, CDialog)
    //{{AFX_MSG_MAP(CAddProperty)
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CAddProperty message handlers

void CAddProperty::OnOK()
{
    UpdateData();
    if (m_cstrName.IsEmpty())
    {
        AfxMessageBox(IDS_PROPERTYNAMEISNEED);
        return;
    }
    if (m_cstrType.IsEmpty())
    {
        AfxMessageBox(IDS_PROPERTYTYPEISNEED);
        return;
    }

    CDialog::OnOK();
}


Examples - C++ LineType - AddProperty.h

AddProperty.h

C++ LineType Example

#if !defined(AFX_ADDPROPERTY_H__FF48D0B3_A20A_11D1_B7A1_000021452DB6__INCLUDED_)
#define AFX_ADDPROPERTY_H__FF48D0B3_A20A_11D1_B7A1_000021452DB6__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000
// AddProperty.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CAddProperty dialog

class CAddProperty : public CDialog
{
// Construction
public:
    CAddProperty(CWnd* pParent = NULL);   // standard constructor

// Dialog Data
    //{{AFX_DATA(CAddProperty)
    enum { IDD = IDD_ADDPROPERTY };
    CString	m_cstrName;
    CString	m_cstrType;
    BOOL	m_bReadOnly;
    //}}AFX_DATA

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CAddProperty)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:

    // Generated message map functions
    //{{AFX_MSG(CAddProperty)
    virtual void OnOK();
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_ADDPROPERTY_H__FF48D0B3_A20A_11D1_B7A1_000021452DB6__INCLUDED_)


Examples - C++ LineType - AddSymbolDlg.cpp

AddSymbolDlg.cpp

C++ LineType Example

// AddSymbolDlg.cpp : implementation file
//

#include "stdafx.h"
#include "ltsample.h"
#include "AddSymbolDlg.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CAddSymbolDlg dialog

CAddSymbolDlg::CAddSymbolDlg(CWnd* pParent /*=NULL*/)
    : CDialog(CAddSymbolDlg::IDD, pParent)
{
    //{{AFX_DATA_INIT(CAddSymbolDlg)
        // NOTE: the ClassWizard will add member initialization here
    m_iInsert = 1;
    //}}AFX_DATA_INIT
}

void CAddSymbolDlg::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CAddSymbolDlg)
        // NOTE: the ClassWizard will add DDX and DDV calls here
    DDX_Radio(pDX, IDC_SMART_OBJECT, m_iInsert);
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CAddSymbolDlg, CDialog)
    //{{AFX_MSG_MAP(CAddSymbolDlg)
        // NOTE: the ClassWizard will add message map macros here
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CAddSymbolDlg message handlers


Examples - C++ LineType - AddSymbolDlg.h

AddSymbolDlg.h

C++ LineType Example

#if !defined(AFX_ADDSYMBOLDLG_H__AFD14C45_BE29_11D1_B7DE_000021452DB6__INCLUDED_)
#define AFX_ADDSYMBOLDLG_H__AFD14C45_BE29_11D1_B7DE_000021452DB6__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000
// AddSymbolDlg.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CAddSymbolDlg dialog

class CAddSymbolDlg : public CDialog
{
// Construction
public:
    CAddSymbolDlg(CWnd* pParent = NULL);   // standard constructor

// Dialog Data
    //{{AFX_DATA(CAddSymbolDlg)
    enum { IDD = IDD_ADD_SYMBOL };
        // NOTE: the ClassWizard will add data members here
    int m_iInsert;
    //}}AFX_DATA

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CAddSymbolDlg)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:

    // Generated message map functions
    //{{AFX_MSG(CAddSymbolDlg)
        // NOTE: the ClassWizard will add member functions here
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_ADDSYMBOLDLG_H__AFD14C45_BE29_11D1_B7DE_000021452DB6__INCLUDED_)


Examples - C++ LineType - DlgProxy.cpp

DlgProxy.cpp

C++ LineType Example

// DlgProxy.cpp : implementation file
//

#include "stdafx.h"
#include "LTSample.h"
#include "DlgProxy.h"
#include "VpWnd.h"
#include "LTSampleDlg.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CLTSampleDlgAutoProxy

IMPLEMENT_DYNCREATE(CLTSampleDlgAutoProxy, CCmdTarget)

CLTSampleDlgAutoProxy::CLTSampleDlgAutoProxy()
{
    EnableAutomation();

    // To keep the application running as long as an OLE automation
    //	object is active, the constructor calls AfxOleLockApp.
    AfxOleLockApp();

    // Get access to the dialog through the application's
    //  main window pointer.  Set the proxy's internal pointer
    //  to point to the dialog, and set the dialog's back pointer to
    //  this proxy.
    ASSERT (AfxGetApp()->m_pMainWnd != NULL);
    ASSERT_VALID (AfxGetApp()->m_pMainWnd);
    ASSERT_KINDOF(CLTSampleDlg, AfxGetApp()->m_pMainWnd);
    m_pDialog = (CLTSampleDlg*) AfxGetApp()->m_pMainWnd;
    m_pDialog->m_pAutoProxy = this;
}

CLTSampleDlgAutoProxy::~CLTSampleDlgAutoProxy()
{
    // To terminate the application when all objects created with
    // 	with OLE automation, the destructor calls AfxOleUnlockApp.
    //  Among other things, this will destroy the main dialog
    AfxOleUnlockApp();
}

void CLTSampleDlgAutoProxy::OnFinalRelease()
{
    // When the last reference for an automation object is released
    // OnFinalRelease is called.  The base class will automatically
    // deletes the object.  Add additional cleanup required for your
    // object before calling the base class.

    CCmdTarget::OnFinalRelease();
}

BEGIN_MESSAGE_MAP(CLTSampleDlgAutoProxy, CCmdTarget)
    //{{AFX_MSG_MAP(CLTSampleDlgAutoProxy)
        // NOTE - the ClassWizard will add and remove mapping macros here.
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

BEGIN_DISPATCH_MAP(CLTSampleDlgAutoProxy, CCmdTarget)
    //{{AFX_DISPATCH_MAP(CLTSampleDlgAutoProxy)
        // NOTE - the ClassWizard will add and remove mapping macros here.
    //}}AFX_DISPATCH_MAP
END_DISPATCH_MAP()

// Note: we add support for IID_ILTSample to support typesafe binding
//  from VBA.  This IID must match the GUID that is attached to the
//  dispinterface in the .ODL file.

// {31176189-A076-11D1-B79F-000021452DB6}
static const IID IID_ILTSample =
{ 0x31176189, 0xa076, 0x11d1, { 0xb7, 0x9f, 0x0, 0x0, 0x21, 0x45, 0x2d, 0xb6 } };

BEGIN_INTERFACE_MAP(CLTSampleDlgAutoProxy, CCmdTarget)
    INTERFACE_PART(CLTSampleDlgAutoProxy, IID_ILTSample, Dispatch)
END_INTERFACE_MAP()

// The IMPLEMENT_OLECREATE2 macro is defined in StdAfx.h of this project
// {31176187-A076-11D1-B79F-000021452DB6}
IMPLEMENT_OLECREATE2(CLTSampleDlgAutoProxy, "LTSample.Application", 0x31176187, 0xa076, 0x11d1, 0xb7, 0x9f, 0x0, 0x0, 0x21, 0x45, 0x2d, 0xb6)

/////////////////////////////////////////////////////////////////////////////
// CLTSampleDlgAutoProxy message handlers


Examples - C++ LineType - DlgProxy.h

DlgProxy.h

C++ LineType Example

// DlgProxy.h : header file
//

#if !defined(AFX_DLGPROXY_H__31176190_A076_11D1_B79F_000021452DB6__INCLUDED_)
#define AFX_DLGPROXY_H__31176190_A076_11D1_B79F_000021452DB6__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000

class CLTSampleDlg;

/////////////////////////////////////////////////////////////////////////////
// CLTSampleDlgAutoProxy command target

class CLTSampleDlgAutoProxy : public CCmdTarget
{
    DECLARE_DYNCREATE(CLTSampleDlgAutoProxy)

    CLTSampleDlgAutoProxy();           // protected constructor used by dynamic creation

// Attributes
public:
    CLTSampleDlg* m_pDialog;

// Operations
public:

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CLTSampleDlgAutoProxy)
    public:
    virtual void OnFinalRelease();
    //}}AFX_VIRTUAL

// Implementation
protected:
    virtual ~CLTSampleDlgAutoProxy();

    // Generated message map functions
    //{{AFX_MSG(CLTSampleDlgAutoProxy)
        // NOTE - the ClassWizard will add and remove member functions here.
    //}}AFX_MSG

    DECLARE_MESSAGE_MAP()
    DECLARE_OLECREATE(CLTSampleDlgAutoProxy)

    // Generated OLE dispatch map functions
    //{{AFX_DISPATCH(CLTSampleDlgAutoProxy)
        // NOTE - the ClassWizard will add and remove member functions here.
    //}}AFX_DISPATCH
    DECLARE_DISPATCH_MAP()
    DECLARE_INTERFACE_MAP()
};

/////////////////////////////////////////////////////////////////////////////

//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_DLGPROXY_H__31176190_A076_11D1_B79F_000021452DB6__INCLUDED_)


Examples - C++ LineType - imsigx50.cpp

imsigx50.cpp

C++ LineType Example

// Machine generated IDispatch wrapper class(es) created with ClassWizard

#include "stdafx.h"
#include "imsigx50.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// IApplication properties

/////////////////////////////////////////////////////////////////////////////
// IApplication operations

LPDISPATCH IApplication::GetActiveDrawing()
{
    LPDISPATCH result;
    InvokeHelper(0x60020000, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

CString IApplication::GetActivePrinter()
{
    CString result;
    InvokeHelper(0x60020001, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

void IApplication::SetActivePrinter(LPCTSTR lpszNewValue)
{
    static BYTE parms[] =
        VTS_BSTR;
    InvokeHelper(0x60020001, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         lpszNewValue);
}

LPDISPATCH IApplication::GetActiveWindow()
{
    LPDISPATCH result;
    InvokeHelper(0x60020003, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetAddIns()
{
    LPDISPATCH result;
    InvokeHelper(0x60020004, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetApplication()
{
    LPDISPATCH result;
    InvokeHelper(0x60020005, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

CString IApplication::GetBuild()
{
    CString result;
    InvokeHelper(0x60020006, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetCallbacks()
{
    LPDISPATCH result;
    InvokeHelper(0x60020007, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

CString IApplication::GetCaption()
{
    CString result;
    InvokeHelper(0x60020008, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

void IApplication::SetCaption(LPCTSTR lpszNewValue)
{
    static BYTE parms[] =
        VTS_BSTR;
    InvokeHelper(0x60020008, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         lpszNewValue);
}

BOOL IApplication::GetDisplayBlocksWindow()
{
    BOOL result;
    InvokeHelper(0x6002000a, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayBlocksWindow(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x6002000a, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplayEditBar()
{
    BOOL result;
    InvokeHelper(0x6002000c, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayEditBar(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x6002000c, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplayFullScreen()
{
    BOOL result;
    InvokeHelper(0x6002000e, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayFullScreen(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x6002000e, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplayInfoWindow()
{
    BOOL result;
    InvokeHelper(0x60020010, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayInfoWindow(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020010, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplayRulers()
{
    BOOL result;
    InvokeHelper(0x60020012, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayRulers(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020012, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplayScrollBars()
{
    BOOL result;
    InvokeHelper(0x60020014, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayScrollBars(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020014, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplayStatusBar()
{
    BOOL result;
    InvokeHelper(0x60020016, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayStatusBar(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020016, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplayStatusDialog()
{
    BOOL result;
    InvokeHelper(0x60020018, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayStatusDialog(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020018, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplaySymbolWindow()
{
    BOOL result;
    InvokeHelper(0x6002001a, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplaySymbolWindow(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x6002001a, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

LPDISPATCH IApplication::GetDrawings()
{
    LPDISPATCH result;
    InvokeHelper(0x6002001c, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetFilters()
{
    LPDISPATCH result;
    InvokeHelper(0x6002001d, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

double IApplication::GetHeight()
{
    double result;
    InvokeHelper(0x6002001e, DISPATCH_PROPERTYGET, VT_R8, (void*)&result, NULL);
    return result;
}

void IApplication::SetHeight(double newValue)
{
    static BYTE parms[] =
        VTS_R8;
    InvokeHelper(0x6002001e, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         newValue);
}

BOOL IApplication::GetInteractive()
{
    BOOL result;
    InvokeHelper(0x60020020, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetInteractive(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020020, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

LPDISPATCH IApplication::GetKeyBindings()
{
    LPDISPATCH result;
    InvokeHelper(0x60020022, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

double IApplication::GetLeft()
{
    double result;
    InvokeHelper(0x60020023, DISPATCH_PROPERTYGET, VT_R8, (void*)&result, NULL);
    return result;
}

void IApplication::SetLeft(double newValue)
{
    static BYTE parms[] =
        VTS_R8;
    InvokeHelper(0x60020023, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         newValue);
}

CString IApplication::GetLibraryPath()
{
    CString result;
    InvokeHelper(0x60020025, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

void IApplication::SetLibraryPath(LPCTSTR lpszNewValue)
{
    static BYTE parms[] =
        VTS_BSTR;
    InvokeHelper(0x60020025, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         lpszNewValue);
}

CString IApplication::GetName()
{
    CString result;
    InvokeHelper(0x0, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetNamedColors()
{
    LPDISPATCH result;
    InvokeHelper(0x60020028, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

CString IApplication::GetOperatingSystem()
{
    CString result;
    InvokeHelper(0x60020029, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetOptions()
{
    LPDISPATCH result;
    InvokeHelper(0x6002002a, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

CString IApplication::GetOrganizationName()
{
    CString result;
    InvokeHelper(0x6002002b, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetParent()
{
    LPDISPATCH result;
    InvokeHelper(0x6002002c, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

CString IApplication::GetPath()
{
    CString result;
    InvokeHelper(0x6002002d, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

CString IApplication::GetProfileName()
{
    CString result;
    InvokeHelper(0x6002002e, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

void IApplication::SetProfileName(LPCTSTR lpszNewValue)
{
    static BYTE parms[] =
        VTS_BSTR;
    InvokeHelper(0x6002002e, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         lpszNewValue);
}

long IApplication::MessageBox(LPCTSTR Message, VARIANT* Flags)
{
    long result;
    static BYTE parms[] =
        VTS_BSTR VTS_PVARIANT;
    InvokeHelper(0x60020030, DISPATCH_METHOD, VT_I4, (void*)&result, parms,
        Message, Flags);
    return result;
}

LPDISPATCH IApplication::GetProperties()
{
    LPDISPATCH result;
    InvokeHelper(0x60020031, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetRegenMethods()
{
    LPDISPATCH result;
    InvokeHelper(0x60020032, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetScaleSystems()
{
    LPDISPATCH result;
    InvokeHelper(0x60020033, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

BOOL IApplication::GetScreenUpdating()
{
    BOOL result;
    InvokeHelper(0x60020034, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetScreenUpdating(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020034, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

LPDISPATCH IApplication::GetSelection()
{
    LPDISPATCH result;
    InvokeHelper(0x60020036, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

BOOL IApplication::GetShowToolTips()
{
    BOOL result;
    InvokeHelper(0x60020037, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetShowToolTips(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020037, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

long IApplication::GetSnapModes()
{
    long result;
    InvokeHelper(0x60020039, DISPATCH_PROPERTYGET, VT_I4, (void*)&result, NULL);
    return result;
}

void IApplication::SetSnapModes(long nNewValue)
{
    static BYTE parms[] =
        VTS_I4;
    InvokeHelper(0x60020039, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         nNewValue);
}

void IApplication::SetStatusBar(LPCTSTR lpszNewValue)
{
    static BYTE parms[] =
        VTS_BSTR;
    InvokeHelper(0x6002003b, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         lpszNewValue);
}

void IApplication::SetStatusDialogText(LPCTSTR prop, VARIANT* newValue)
{
    static BYTE parms[] =
        VTS_BSTR VTS_PVARIANT;
    InvokeHelper(0x6002003c, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         prop, newValue);
}

LPDISPATCH IApplication::GetTables()
{
    LPDISPATCH result;
    InvokeHelper(0x6002003d, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

CString IApplication::GetTemplatesPath()
{
    CString result;
    InvokeHelper(0x6002003e, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

void IApplication::SetTemplatesPath(LPCTSTR lpszNewValue)
{
    static BYTE parms[] =
        VTS_BSTR;
    InvokeHelper(0x6002003e, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         lpszNewValue);
}

LPDISPATCH IApplication::GetCommandBars()
{
    LPDISPATCH result;
    InvokeHelper(0x60020040, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetTools()
{
    LPDISPATCH result;
    InvokeHelper(0x60020041, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

double IApplication::GetTop()
{
    double result;
    InvokeHelper(0x60020042, DISPATCH_PROPERTYGET, VT_R8, (void*)&result, NULL);
    return result;
}

void IApplication::SetTop(double newValue)
{
    static BYTE parms[] =
        VTS_R8;
    InvokeHelper(0x60020042, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         newValue);
}

double IApplication::GetUsableHeight()
{
    double result;
    InvokeHelper(0x60020044, DISPATCH_PROPERTYGET, VT_R8, (void*)&result, NULL);
    return result;
}

double IApplication::GetUsableWidth()
{
    double result;
    InvokeHelper(0x60020045, DISPATCH_PROPERTYGET, VT_R8, (void*)&result, NULL);
    return result;
}

BOOL IApplication::GetUserControl()
{
    BOOL result;
    InvokeHelper(0x60020046, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetUserControl(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020046, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

CString IApplication::GetUserName_()
{
    CString result;
    InvokeHelper(0x60020048, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

void IApplication::SetUserName(LPCTSTR lpszNewValue)
{
    static BYTE parms[] =
        VTS_BSTR;
    InvokeHelper(0x60020048, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         lpszNewValue);
}

CString IApplication::GetVersion()
{
    CString result;
    InvokeHelper(0x6002004a, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

BOOL IApplication::GetVisible()
{
    BOOL result;
    InvokeHelper(0x6002004b, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetVisible(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x6002004b, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

double IApplication::GetWidth()
{
    double result;
    InvokeHelper(0x6002004d, DISPATCH_PROPERTYGET, VT_R8, (void*)&result, NULL);
    return result;
}

void IApplication::SetWidth(double newValue)
{
    static BYTE parms[] =
        VTS_R8;
    InvokeHelper(0x6002004d, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         newValue);
}

long IApplication::GetWindowState()
{
    long result;
    InvokeHelper(0x6002004f, DISPATCH_PROPERTYGET, VT_I4, (void*)&result, NULL);
    return result;
}

void IApplication::SetWindowState(long nNewValue)
{
    static BYTE parms[] =
        VTS_I4;
    InvokeHelper(0x6002004f, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         nNewValue);
}

LPDISPATCH IApplication::GetWindows()
{
    LPDISPATCH result;
    InvokeHelper(0x60020051, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

long IApplication::BuildKeyCode(long BaseKey, VARIANT* ModKey, VARIANT* ModKey2, VARIANT* ModKey3)
{
    long result;
    static BYTE parms[] =
        VTS_I4 VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x60020052, DISPATCH_METHOD, VT_I4, (void*)&result, parms,
        BaseKey, ModKey, ModKey2, ModKey3);
    return result;
}

BOOL IApplication::CheckSpelling(LPCTSTR Word, VARIANT* CustomDictionary, VARIANT* IgnoreUppercase, VARIANT* CustomDictionary2, VARIANT* CustomDictionary3, VARIANT* CustomDictionary4, VARIANT* CustomDictionary5, VARIANT* CustomDictionary6,
        VARIANT* CustomDictionary7, VARIANT* CustomDictionary8, VARIANT* CustomDictionary9, VARIANT* CustomDictionary10)
{
    BOOL result;
    static BYTE parms[] =
        VTS_BSTR VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x60020053, DISPATCH_METHOD, VT_BOOL, (void*)&result, parms,
        Word, CustomDictionary, IgnoreUppercase, CustomDictionary2, CustomDictionary3, CustomDictionary4, CustomDictionary5, CustomDictionary6, CustomDictionary7, CustomDictionary8, CustomDictionary9, CustomDictionary10);
    return result;
}

CString IApplication::GetOpenFilename(VARIANT* Filter, VARIANT* Title, VARIANT* ButtonText, VARIANT* MultiSelect)
{
    CString result;
    static BYTE parms[] =
        VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x60020054, DISPATCH_METHOD, VT_BSTR, (void*)&result, parms,
        Filter, Title, ButtonText, MultiSelect);
    return result;
}

CString IApplication::GetSaveAsFilename(VARIANT* InitialFilename, VARIANT* Filter, VARIANT* Title, VARIANT* ButtonText)
{
    CString result;
    static BYTE parms[] =
        VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x60020055, DISPATCH_METHOD, VT_BSTR, (void*)&result, parms,
        InitialFilename, Filter, Title, ButtonText);
    return result;
}

void IApplication::Help(VARIANT* HelpFile, VARIANT* HelpContextID)
{
    static BYTE parms[] =
        VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x60020056, DISPATCH_METHOD, VT_EMPTY, NULL, parms,
         HelpFile, HelpContextID);
}

VARIANT IApplication::InputBox(VARIANT* bstrPrompt, VARIANT* bstrTitle, VARIANT* Default, VARIANT* sLeft, VARIANT* sTop, VARIANT* bstrHelpFile, VARIANT* ulHelpContextID, VARIANT* sType)
{
    VARIANT result;
    static BYTE parms[] =
        VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x60020057, DISPATCH_METHOD, VT_VARIANT, (void*)&result, parms,
        bstrPrompt, bstrTitle, Default, sLeft, sTop, bstrHelpFile, ulHelpContextID, sType);
    return result;
}

CString IApplication::KeyString(long KeyCode, VARIANT* KeyCode2)
{
    CString result;
    static BYTE parms[] =
        VTS_I4 VTS_PVARIANT;
    InvokeHelper(0x60020058, DISPATCH_METHOD, VT_BSTR, (void*)&result, parms,
        KeyCode, KeyCode2);
    return result;
}

void IApplication::PopGraphicDefaults(VARIANT* PrevDefaults)
{
    static BYTE parms[] =
        VTS_PVARIANT;
    InvokeHelper(0x60020059, DISPATCH_METHOD, VT_EMPTY, NULL, parms,
         PrevDefaults);
}

void IApplication::PopVertexDefaults(VARIANT* PrevDefaults)
{
    static BYTE parms[] =
        VTS_PVARIANT;
    InvokeHelper(0x6002005a, DISPATCH_METHOD, VT_EMPTY, NULL, parms,
         PrevDefaults);
}

long IApplication::PushGraphicDefaults(VARIANT* Editable, VARIANT* Visible, VARIANT* Cosmetic, VARIANT* Unbounded)
{
    long result;
    static BYTE parms[] =
        VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x6002005b, DISPATCH_METHOD, VT_I4, (void*)&result, parms,
        Editable, Visible, Cosmetic, Unbounded);
    return result;
}

long IApplication::PushVertexDefaults(VARIANT* PenDown, VARIANT* Selectable, VARIANT* Snappable, VARIANT* Editable, VARIANT* Linkable, VARIANT* Calculated)
{
    long result;
    static BYTE parms[] =
        VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x6002005c, DISPATCH_METHOD, VT_I4, (void*)&result, parms,
        PenDown, Selectable, Snappable, Editable, Linkable, Calculated);
    return result;
}

void IApplication::Quit()
{
    InvokeHelper(0x6002005d, DISPATCH_METHOD, VT_EMPTY, NULL, NULL);
}

BOOL IApplication::Redo(VARIANT* Times)
{
    BOOL result;
    static BYTE parms[] =
        VTS_PVARIANT;
    InvokeHelper(0x6002005e, DISPATCH_METHOD, VT_BOOL, (void*)&result, parms,
        Times);
    return result;
}

BOOL IApplication::Repeat(VARIANT* Times)
{
    BOOL result;
    static BYTE parms[] =
        VTS_PVARIANT;
    InvokeHelper(0x6002005f, DISPATCH_METHOD, VT_BOOL, (void*)&result, parms,
        Times);
    return result;
}

VARIANT IApplication::RunMacro(VARIANT* Macro, VARIANT* Arg1, VARIANT* Arg2, VARIANT* Arg3, VARIANT* Arg4, VARIANT* Arg5, VARIANT* Arg6, VARIANT* Arg7, VARIANT* Arg8, VARIANT* Arg9, VARIANT* Arg10, VARIANT* Arg11, VARIANT* Arg12, VARIANT* Arg13,
        VARIANT* Arg14, VARIANT* Arg15, VARIANT* Arg16)
{
    VARIANT result;
    static BYTE parms[] =
        VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x60020060, DISPATCH_METHOD, VT_VARIANT, (void*)&result, parms,
        Macro, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16);
    return result;
}

void IApplication::SaveWorkspace(VARIANT* bstrFilename)
{
    static BYTE parms[] =
        VTS_PVARIANT;
    InvokeHelper(0x60020061, DISPATCH_METHOD, VT_EMPTY, NULL, parms,
         bstrFilename);
}

BOOL IApplication::Undo(VARIANT* Times)
{
    BOOL result;
    static BYTE parms[] =
        VTS_PVARIANT;
    InvokeHelper(0x60020062, DISPATCH_METHOD, VT_BOOL, (void*)&result, parms,
        Times);
    return result;
}

long IApplication::ConnectEvents(LPDISPATCH EventSink, VARIANT* EventMask)
{
    long result;
    static BYTE parms[] =
        VTS_DISPATCH VTS_PVARIANT;
    InvokeHelper(0x60020066, DISPATCH_METHOD, VT_I4, (void*)&result, parms,
        EventSink, EventMask);
    return result;
}

void IApplication::DisconnectEvents(long ConnectionID)
{
    static BYTE parms[] =
        VTS_I4;
    InvokeHelper(0x60020067, DISPATCH_METHOD, VT_EMPTY, NULL, parms,
         ConnectionID);
}

/////////////////////////////////////////////////////////////////////////////
// IApplication properties

/////////////////////////////////////////////////////////////////////////////
// IApplication operations

LPDISPATCH IApplication::GetActiveDrawing()
{
    LPDISPATCH result;
    InvokeHelper(0x60020000, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

CString IApplication::GetActivePrinter()
{
    CString result;
    InvokeHelper(0x60020001, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

void IApplication::SetActivePrinter(LPCTSTR lpszNewValue)
{
    static BYTE parms[] =
        VTS_BSTR;
    InvokeHelper(0x60020001, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         lpszNewValue);
}

LPDISPATCH IApplication::GetActiveWindow()
{
    LPDISPATCH result;
    InvokeHelper(0x60020003, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetAddIns()
{
    LPDISPATCH result;
    InvokeHelper(0x60020004, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetApplication()
{
    LPDISPATCH result;
    InvokeHelper(0x60020005, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

CString IApplication::GetBuild()
{
    CString result;
    InvokeHelper(0x60020006, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetCallbacks()
{
    LPDISPATCH result;
    InvokeHelper(0x60020007, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

CString IApplication::GetCaption()
{
    CString result;
    InvokeHelper(0x60020008, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

void IApplication::SetCaption(LPCTSTR lpszNewValue)
{
    static BYTE parms[] =
        VTS_BSTR;
    InvokeHelper(0x60020008, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         lpszNewValue);
}

BOOL IApplication::GetDisplayBlocksWindow()
{
    BOOL result;
    InvokeHelper(0x6002000a, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayBlocksWindow(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x6002000a, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplayEditBar()
{
    BOOL result;
    InvokeHelper(0x6002000c, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayEditBar(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x6002000c, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplayFullScreen()
{
    BOOL result;
    InvokeHelper(0x6002000e, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayFullScreen(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x6002000e, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplayInfoWindow()
{
    BOOL result;
    InvokeHelper(0x60020010, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayInfoWindow(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020010, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplayRulers()
{
    BOOL result;
    InvokeHelper(0x60020012, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayRulers(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020012, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplayScrollBars()
{
    BOOL result;
    InvokeHelper(0x60020014, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayScrollBars(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020014, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplayStatusBar()
{
    BOOL result;
    InvokeHelper(0x60020016, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayStatusBar(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020016, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplayStatusDialog()
{
    BOOL result;
    InvokeHelper(0x60020018, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplayStatusDialog(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020018, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

BOOL IApplication::GetDisplaySymbolWindow()
{
    BOOL result;
    InvokeHelper(0x6002001a, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetDisplaySymbolWindow(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x6002001a, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

LPDISPATCH IApplication::GetDrawings()
{
    LPDISPATCH result;
    InvokeHelper(0x6002001c, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetFilters()
{
    LPDISPATCH result;
    InvokeHelper(0x6002001d, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

double IApplication::GetHeight()
{
    double result;
    InvokeHelper(0x6002001e, DISPATCH_PROPERTYGET, VT_R8, (void*)&result, NULL);
    return result;
}

void IApplication::SetHeight(double newValue)
{
    static BYTE parms[] =
        VTS_R8;
    InvokeHelper(0x6002001e, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         newValue);
}

BOOL IApplication::GetInteractive()
{
    BOOL result;
    InvokeHelper(0x60020020, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetInteractive(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020020, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

LPDISPATCH IApplication::GetKeyBindings()
{
    LPDISPATCH result;
    InvokeHelper(0x60020022, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

double IApplication::GetLeft()
{
    double result;
    InvokeHelper(0x60020023, DISPATCH_PROPERTYGET, VT_R8, (void*)&result, NULL);
    return result;
}

void IApplication::SetLeft(double newValue)
{
    static BYTE parms[] =
        VTS_R8;
    InvokeHelper(0x60020023, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         newValue);
}

CString IApplication::GetLibraryPath()
{
    CString result;
    InvokeHelper(0x60020025, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

void IApplication::SetLibraryPath(LPCTSTR lpszNewValue)
{
    static BYTE parms[] =
        VTS_BSTR;
    InvokeHelper(0x60020025, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         lpszNewValue);
}

CString IApplication::GetName()
{
    CString result;
    InvokeHelper(0x0, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetNamedColors()
{
    LPDISPATCH result;
    InvokeHelper(0x60020028, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

CString IApplication::GetOperatingSystem()
{
    CString result;
    InvokeHelper(0x60020029, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetOptions()
{
    LPDISPATCH result;
    InvokeHelper(0x6002002a, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

CString IApplication::GetOrganizationName()
{
    CString result;
    InvokeHelper(0x6002002b, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetParent()
{
    LPDISPATCH result;
    InvokeHelper(0x6002002c, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

CString IApplication::GetPath()
{
    CString result;
    InvokeHelper(0x6002002d, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

CString IApplication::GetProfileName()
{
    CString result;
    InvokeHelper(0x6002002e, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

void IApplication::SetProfileName(LPCTSTR lpszNewValue)
{
    static BYTE parms[] =
        VTS_BSTR;
    InvokeHelper(0x6002002e, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         lpszNewValue);
}

long IApplication::MessageBox(LPCTSTR Message, VARIANT* Flags)
{
    long result;
    static BYTE parms[] =
        VTS_BSTR VTS_PVARIANT;
    InvokeHelper(0x60020030, DISPATCH_METHOD, VT_I4, (void*)&result, parms,
        Message, Flags);
    return result;
}

LPDISPATCH IApplication::GetProperties()
{
    LPDISPATCH result;
    InvokeHelper(0x60020031, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetRegenMethods()
{
    LPDISPATCH result;
    InvokeHelper(0x60020032, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetScaleSystems()
{
    LPDISPATCH result;
    InvokeHelper(0x60020033, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

BOOL IApplication::GetScreenUpdating()
{
    BOOL result;
    InvokeHelper(0x60020034, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetScreenUpdating(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020034, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

LPDISPATCH IApplication::GetSelection()
{
    LPDISPATCH result;
    InvokeHelper(0x60020036, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

BOOL IApplication::GetShowToolTips()
{
    BOOL result;
    InvokeHelper(0x60020037, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetShowToolTips(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020037, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

long IApplication::GetSnapModes()
{
    long result;
    InvokeHelper(0x60020039, DISPATCH_PROPERTYGET, VT_I4, (void*)&result, NULL);
    return result;
}

void IApplication::SetSnapModes(long nNewValue)
{
    static BYTE parms[] =
        VTS_I4;
    InvokeHelper(0x60020039, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         nNewValue);
}

void IApplication::SetStatusBar(LPCTSTR lpszNewValue)
{
    static BYTE parms[] =
        VTS_BSTR;
    InvokeHelper(0x6002003b, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         lpszNewValue);
}

void IApplication::SetStatusDialogText(LPCTSTR prop, VARIANT* newValue)
{
    static BYTE parms[] =
        VTS_BSTR VTS_PVARIANT;
    InvokeHelper(0x6002003c, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         prop, newValue);
}

LPDISPATCH IApplication::GetTables()
{
    LPDISPATCH result;
    InvokeHelper(0x6002003d, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

CString IApplication::GetTemplatesPath()
{
    CString result;
    InvokeHelper(0x6002003e, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

void IApplication::SetTemplatesPath(LPCTSTR lpszNewValue)
{
    static BYTE parms[] =
        VTS_BSTR;
    InvokeHelper(0x6002003e, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         lpszNewValue);
}

LPDISPATCH IApplication::GetCommandBars()
{
    LPDISPATCH result;
    InvokeHelper(0x60020040, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

LPDISPATCH IApplication::GetTools()
{
    LPDISPATCH result;
    InvokeHelper(0x60020041, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

double IApplication::GetTop()
{
    double result;
    InvokeHelper(0x60020042, DISPATCH_PROPERTYGET, VT_R8, (void*)&result, NULL);
    return result;
}

void IApplication::SetTop(double newValue)
{
    static BYTE parms[] =
        VTS_R8;
    InvokeHelper(0x60020042, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         newValue);
}

double IApplication::GetUsableHeight()
{
    double result;
    InvokeHelper(0x60020044, DISPATCH_PROPERTYGET, VT_R8, (void*)&result, NULL);
    return result;
}

double IApplication::GetUsableWidth()
{
    double result;
    InvokeHelper(0x60020045, DISPATCH_PROPERTYGET, VT_R8, (void*)&result, NULL);
    return result;
}

BOOL IApplication::GetUserControl()
{
    BOOL result;
    InvokeHelper(0x60020046, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetUserControl(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x60020046, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

CString IApplication::GetUserName_()
{
    CString result;
    InvokeHelper(0x60020048, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

void IApplication::SetUserName(LPCTSTR lpszNewValue)
{
    static BYTE parms[] =
        VTS_BSTR;
    InvokeHelper(0x60020048, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         lpszNewValue);
}

CString IApplication::GetVersion()
{
    CString result;
    InvokeHelper(0x6002004a, DISPATCH_PROPERTYGET, VT_BSTR, (void*)&result, NULL);
    return result;
}

BOOL IApplication::GetVisible()
{
    BOOL result;
    InvokeHelper(0x6002004b, DISPATCH_PROPERTYGET, VT_BOOL, (void*)&result, NULL);
    return result;
}

void IApplication::SetVisible(BOOL bNewValue)
{
    static BYTE parms[] =
        VTS_BOOL;
    InvokeHelper(0x6002004b, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         bNewValue);
}

double IApplication::GetWidth()
{
    double result;
    InvokeHelper(0x6002004d, DISPATCH_PROPERTYGET, VT_R8, (void*)&result, NULL);
    return result;
}

void IApplication::SetWidth(double newValue)
{
    static BYTE parms[] =
        VTS_R8;
    InvokeHelper(0x6002004d, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         newValue);
}

long IApplication::GetWindowState()
{
    long result;
    InvokeHelper(0x6002004f, DISPATCH_PROPERTYGET, VT_I4, (void*)&result, NULL);
    return result;
}

void IApplication::SetWindowState(long nNewValue)
{
    static BYTE parms[] =
        VTS_I4;
    InvokeHelper(0x6002004f, DISPATCH_PROPERTYPUT, VT_EMPTY, NULL, parms,
         nNewValue);
}

LPDISPATCH IApplication::GetWindows()
{
    LPDISPATCH result;
    InvokeHelper(0x60020051, DISPATCH_PROPERTYGET, VT_DISPATCH, (void*)&result, NULL);
    return result;
}

long IApplication::BuildKeyCode(long BaseKey, VARIANT* ModKey, VARIANT* ModKey2, VARIANT* ModKey3)
{
    long result;
    static BYTE parms[] =
        VTS_I4 VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x60020052, DISPATCH_METHOD, VT_I4, (void*)&result, parms,
        BaseKey, ModKey, ModKey2, ModKey3);
    return result;
}

BOOL IApplication::CheckSpelling(LPCTSTR Word, VARIANT* CustomDictionary, VARIANT* IgnoreUppercase, VARIANT* CustomDictionary2, VARIANT* CustomDictionary3, VARIANT* CustomDictionary4, VARIANT* CustomDictionary5, VARIANT* CustomDictionary6,
        VARIANT* CustomDictionary7, VARIANT* CustomDictionary8, VARIANT* CustomDictionary9, VARIANT* CustomDictionary10)
{
    BOOL result;
    static BYTE parms[] =
        VTS_BSTR VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x60020053, DISPATCH_METHOD, VT_BOOL, (void*)&result, parms,
        Word, CustomDictionary, IgnoreUppercase, CustomDictionary2, CustomDictionary3, CustomDictionary4, CustomDictionary5, CustomDictionary6, CustomDictionary7, CustomDictionary8, CustomDictionary9, CustomDictionary10);
    return result;
}

CString IApplication::GetOpenFilename(VARIANT* Filter, VARIANT* Title, VARIANT* ButtonText, VARIANT* MultiSelect)
{
    CString result;
    static BYTE parms[] =
        VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x60020054, DISPATCH_METHOD, VT_BSTR, (void*)&result, parms,
        Filter, Title, ButtonText, MultiSelect);
    return result;
}

CString IApplication::GetSaveAsFilename(VARIANT* InitialFilename, VARIANT* Filter, VARIANT* Title, VARIANT* ButtonText)
{
    CString result;
    static BYTE parms[] =
        VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x60020055, DISPATCH_METHOD, VT_BSTR, (void*)&result, parms,
        InitialFilename, Filter, Title, ButtonText);
    return result;
}

void IApplication::Help(VARIANT* HelpFile, VARIANT* HelpContextID)
{
    static BYTE parms[] =
        VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x60020056, DISPATCH_METHOD, VT_EMPTY, NULL, parms,
         HelpFile, HelpContextID);
}

VARIANT IApplication::InputBox(VARIANT* bstrPrompt, VARIANT* bstrTitle, VARIANT* Default, VARIANT* sLeft, VARIANT* sTop, VARIANT* bstrHelpFile, VARIANT* ulHelpContextID, VARIANT* sType)
{
    VARIANT result;
    static BYTE parms[] =
        VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x60020057, DISPATCH_METHOD, VT_VARIANT, (void*)&result, parms,
        bstrPrompt, bstrTitle, Default, sLeft, sTop, bstrHelpFile, ulHelpContextID, sType);
    return result;
}

CString IApplication::KeyString(long KeyCode, VARIANT* KeyCode2)
{
    CString result;
    static BYTE parms[] =
        VTS_I4 VTS_PVARIANT;
    InvokeHelper(0x60020058, DISPATCH_METHOD, VT_BSTR, (void*)&result, parms,
        KeyCode, KeyCode2);
    return result;
}

void IApplication::PopGraphicDefaults(VARIANT* PrevDefaults)
{
    static BYTE parms[] =
        VTS_PVARIANT;
    InvokeHelper(0x60020059, DISPATCH_METHOD, VT_EMPTY, NULL, parms,
         PrevDefaults);
}

void IApplication::PopVertexDefaults(VARIANT* PrevDefaults)
{
    static BYTE parms[] =
        VTS_PVARIANT;
    InvokeHelper(0x6002005a, DISPATCH_METHOD, VT_EMPTY, NULL, parms,
         PrevDefaults);
}

long IApplication::PushGraphicDefaults(VARIANT* Editable, VARIANT* Visible, VARIANT* Cosmetic, VARIANT* Unbounded)
{
    long result;
    static BYTE parms[] =
        VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x6002005b, DISPATCH_METHOD, VT_I4, (void*)&result, parms,
        Editable, Visible, Cosmetic, Unbounded);
    return result;
}

long IApplication::PushVertexDefaults(VARIANT* PenDown, VARIANT* Selectable, VARIANT* Snappable, VARIANT* Editable, VARIANT* Linkable, VARIANT* Calculated)
{
    long result;
    static BYTE parms[] =
        VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x6002005c, DISPATCH_METHOD, VT_I4, (void*)&result, parms,
        PenDown, Selectable, Snappable, Editable, Linkable, Calculated);
    return result;
}

void IApplication::Quit()
{
    InvokeHelper(0x6002005d, DISPATCH_METHOD, VT_EMPTY, NULL, NULL);
}

BOOL IApplication::Redo(VARIANT* Times)
{
    BOOL result;
    static BYTE parms[] =
        VTS_PVARIANT;
    InvokeHelper(0x6002005e, DISPATCH_METHOD, VT_BOOL, (void*)&result, parms,
        Times);
    return result;
}

BOOL IApplication::Repeat(VARIANT* Times)
{
    BOOL result;
    static BYTE parms[] =
        VTS_PVARIANT;
    InvokeHelper(0x6002005f, DISPATCH_METHOD, VT_BOOL, (void*)&result, parms,
        Times);
    return result;
}

VARIANT IApplication::RunMacro(VARIANT* Macro, VARIANT* Arg1, VARIANT* Arg2, VARIANT* Arg3, VARIANT* Arg4, VARIANT* Arg5, VARIANT* Arg6, VARIANT* Arg7, VARIANT* Arg8, VARIANT* Arg9, VARIANT* Arg10, VARIANT* Arg11, VARIANT* Arg12, VARIANT* Arg13,
        VARIANT* Arg14, VARIANT* Arg15, VARIANT* Arg16)
{
    VARIANT result;
    static BYTE parms[] =
        VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT;
    InvokeHelper(0x60020060, DISPATCH_METHOD, VT_VARIANT, (void*)&result, parms,
        Macro, Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, Arg9, Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16);
    return result;
}

void IApplication::SaveWorkspace(VARIANT* bstrFilename)
{
    static BYTE parms[] =
        VTS_PVARIANT;
    InvokeHelper(0x60020061, DISPATCH_METHOD, VT_EMPTY, NULL, parms,
         bstrFilename);
}

BOOL IApplication::Undo(VARIANT* Times)
{
    BOOL result;
    static BYTE parms[] =
        VTS_PVARIANT;
    InvokeHelper(0x60020062, DISPATCH_METHOD, VT_BOOL, (void*)&result, parms,
        Times);
    return result;
}

long IApplication::ConnectEvents(LPDISPATCH EventSink, VARIANT* EventMask)
{
    long result;
    static BYTE parms[] =
        VTS_DISPATCH VTS_PVARIANT;
    InvokeHelper(0x60020066, DISPATCH_METHOD, VT_I4, (void*)&result, parms,
        EventSink, EventMask);
    return result;
}

void IApplication::DisconnectEvents(long ConnectionID)
{
    static BYTE parms[] =
        VTS_I4;
    InvokeHelper(0x60020067, DISPATCH_METHOD, VT_EMPTY, NULL, parms,
         ConnectionID);
}


Examples - C++ LineType - LTSample.cpp

LTSample.cpp

C++ LineType Example

// LTSample.cpp : Defines the class behaviors for the application.
//

#include "stdafx.h"
#include "LTSample.h"
#include "VpWnd.h"
#include "LTSampleDlg.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CLTSampleApp

BEGIN_MESSAGE_MAP(CLTSampleApp, CWinApp)
    //{{AFX_MSG_MAP(CLTSampleApp)
        // NOTE - the ClassWizard will add and remove mapping macros here.
        //    DO NOT EDIT what you see in these blocks of generated code!
    //}}AFX_MSG
    ON_COMMAND(ID_HELP, CWinApp::OnHelp)
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CLTSampleApp construction

CLTSampleApp::CLTSampleApp()
{
    // TODO: add construction code here,
    // Place all significant initialization in InitInstance
}

/////////////////////////////////////////////////////////////////////////////
// The one and only CLTSampleApp object

CLTSampleApp theApp;

/////////////////////////////////////////////////////////////////////////////
// CLTSampleApp initialization

BOOL CLTSampleApp::InitInstance()
{
    // Initialize OLE libraries
    if (!AfxOleInit())
    {
        AfxMessageBox(IDP_OLE_INIT_FAILED);
        return FALSE;
    }

    AfxEnableControlContainer();

    // Standard initialization
    // If you are not using these features and wish to reduce the size
    //  of your final executable, you should remove from the following
    //  the specific initialization routines you do not need.

#ifdef _AFXDLL
    Enable3dControls();			// Call this when using MFC in a shared DLL
#else
    Enable3dControlsStatic();	// Call this when linking to MFC statically
#endif

    // Parse the command line to see if launched as OLE server
    if (RunEmbedded() || RunAutomated())
    {
        // Register all OLE server (factories) as running.  This enables the
        //  OLE libraries to create objects from other applications.
        COleTemplateServer::RegisterAll();
    }
    else
    {
        // When a server application is launched stand-alone, it is a good idea
        //  to update the system registry in case it has been damaged.
        COleObjectFactory::UpdateRegistryAll();
    }

    CLTSampleDlg dlg;
    m_pMainWnd = &dlg;
    int nResponse = dlg.DoModal();
    if (nResponse == IDOK)
    {
        // TODO: Place code here to handle when the dialog is
        //  dismissed with OK
    }
    else if (nResponse == IDCANCEL)
    {
        // TODO: Place code here to handle when the dialog is
        //  dismissed with Cancel
    }

    // Since the dialog has been closed, return FALSE so that we exit the
    //  application, rather than start the application's message pump.
    return FALSE;
}


Examples - C++ LineType - LTSampleDlg.cpp

LTSampleDlg.cpp

C++ LineType Example

// LTSampleDlg.cpp : implementation file
//

#include "stdafx.h"
#include "LTSample.h"
#include "VpWnd.h"
#include "LTSampleDlg.h"
#include "DlgProxy.h"
#include "PropDialog.h"
#include "SelOptPage.h"
#include "QueryDialog.h"
#include "AddSymbolDlg.h"
#include "SmartObjectInserDlg.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

const CLSID CLSID_Application  = {0x6A481001,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const CLSID CLSID_XApplication = {0x6A481801,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

const IID IID_IApplication = {0x6A481101,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_Graphics = {0x6A48110A,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_IDrawing = {0x6A481107,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

/////////////////////////////////////////////////////////////////////////////
// CAboutDlg dialog used for App About

class CAboutDlg : public CDialog
{
public:
    CAboutDlg();

// Dialog Data
    //{{AFX_DATA(CAboutDlg)
    enum { IDD = IDD_ABOUTBOX };
    //}}AFX_DATA

    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CAboutDlg)
    //}}AFX_VIRTUAL

// Implementation
protected:
    //{{AFX_MSG(CAboutDlg)
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

CAboutDlg::CAboutDlg() : CDialog(CAboutDlg::IDD)
{
    //{{AFX_DATA_INIT(CAboutDlg)
    //}}AFX_DATA_INIT
}

BEGIN_MESSAGE_MAP(CAboutDlg, CDialog)
    //{{AFX_MSG_MAP(CAboutDlg)
        // No message handlers
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CLTSampleDlg dialog

IMPLEMENT_DYNAMIC(CLTSampleDlg, CDialog);

CLTSampleDlg::CLTSampleDlg(CWnd* pParent /*=NULL*/)
    : CDialog(CLTSampleDlg::IDD, pParent)
{
    //{{AFX_DATA_INIT(CLTSampleDlg)
        // NOTE: the ClassWizard will add member initialization here
    //}}AFX_DATA_INIT
    // Note that LoadIcon does not require a subsequent DestroyIcon in Win32
    m_hIcon = AfxGetApp()->LoadIcon(IDR_MAINFRAME);
    m_pAutoProxy = NULL;

    m_pLocalApp = NULL;
    m_pInprocApp = NULL;
    m_pApp = NULL;
    m_iVersion = 0;
}

CLTSampleDlg::~CLTSampleDlg()
{
    // If there is an automation proxy for this dialog, set
    //  its back pointer to this dialog to NULL, so it knows
    //  the dialog has been deleted.
    if (m_pAutoProxy != NULL)
        m_pAutoProxy->m_pDialog = NULL;
}

BEGIN_MESSAGE_MAP(CLTSampleDlg, CDialog)
    //{{AFX_MSG_MAP(CLTSampleDlg)
    ON_WM_SYSCOMMAND()
    ON_WM_PAINT()
    ON_WM_QUERYDRAGICON()
    ON_WM_CLOSE()
    ON_BN_CLICKED(IDC_MERGEDRAWING, OnMergedrawing)
    ON_BN_CLICKED(IDC_OPENDRAWING, OnOpendrawing)
    ON_BN_CLICKED(IDC_PASTE, OnPaste)
    ON_BN_CLICKED(IDC_PROPERTYSYMBOL, OnPropertysymbol)
    ON_BN_CLICKED(IDC_SAVEDRAWING, OnSavedrawing)
    ON_BN_CLICKED(IDC_SELECTSYMBOL, OnSelectsymbol)
    ON_BN_CLICKED(IDC_CREATEAPP, OnCreateapp)
    ON_BN_CLICKED(IDC_SETVIEW, OnSetview)
    ON_BN_CLICKED(IDC_NEWDRAWING, OnNewdrawing)
    ON_BN_CLICKED(IDC_LOCALMODE, OnLocalmode)
    ON_BN_CLICKED(IDC_INPROCMODE, OnInprocmode)
    ON_BN_CLICKED(IDC_DRAWINGPROPERTY, OnDrawingProperty)
    ON_BN_CLICKED(IDC_CLOSEDRAWING, OnClosedrawing)
    ON_BN_CLICKED(IDC_EXPLODESYMBOL, OnExplodesymbol)
    ON_BN_CLICKED(IDC_QUERY, OnQuery)
    ON_BN_CLICKED(IDC_COPYSYMBOL, OnCopysymbol)
    ON_BN_CLICKED(IDC_ADDSYMBOL, OnAddsymbol)
    ON_BN_CLICKED(IDC_REMOVESYMBOL, OnDeletesymbol)
    ON_BN_CLICKED(IDC_APPPROPERTY, OnAppproperty)
    ON_BN_CLICKED(IDC_OPTIONS, OnOptions)
    ON_BN_CLICKED(IDC_GETBLOCK, OnGetblock)
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

void CLTSampleDlg::SyncToApplication(IApplication *pApp, BOOL bGetSelection)
{
    CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
    if (pDwgList != NULL)
    {
        int iCount = pDwgList->GetCount();
        IDrawing *pIDwg = NULL;
        for (int iItem = 0; iItem < iCount; iItem++)
        {
            pIDwg = (IDrawing *)pDwgList->GetItemDataPtr(iItem);
            if (pIDwg != NULL)
                pIDwg->Release();
        }
        pDwgList->ResetContent();
    }

    if (pApp != NULL)
    {
        BSTR bstrVersion = NULL;
        HRESULT hRes = pApp->get_Version(0, &bstrVersion);
        if (SUCCEEDED(hRes)
            && bstrVersion != NULL)
        {
            CString cstrBuild(bstrVersion);
            int iDot = cstrBuild.Find('.');
            CString cstrVersion = cstrBuild.Left(iDot);
            m_iVersion = atoi(cstrVersion);
        }
        else
            m_iVersion = 4;

        // uncorrect reference counting of the Selection object
        // in SDK v 4.x - I have to correct it in the my sample
        if (bGetSelection
            && m_iVersion > 4)
            bGetSelection = FALSE;

        // Get the handle to the drawings collection
        Drawings* pDwgs = NULL;
        hRes = pApp->get_Drawings(&pDwgs);
        if (SUCCEEDED(hRes))
        {
            COleVariant varIndex;
            varIndex.vt = VT_I4;

            Selection *pSelection = NULL;

            for (varIndex.lVal = 0L; ; ++varIndex.lVal)
            {
                IDrawing* pIDwg = NULL;
                hRes = pDwgs->get_Item(&varIndex, &pIDwg);
                if (FAILED(hRes))
                    break;
                AddDrawingToList(pDwgList, pIDwg);

                if (bGetSelection)
                {
                    // correct reference count for the Selection object
                    pIDwg->get_Selection(&pSelection);
                    if (pSelection != NULL)
                    {
                        pSelection->AddRef();
                        pSelection = NULL;
                    }
                }

                pIDwg->Release();
            }
            pDwgs->Release();
        }
    }
    else
        m_iVersion = 0;
    CButton *pCreateAppBt = (CButton *)GetDlgItem(IDC_CREATEAPP);
    if (pCreateAppBt != NULL)
        pCreateAppBt->EnableWindow(pApp == NULL);
}

void CLTSampleDlg::AddDrawingToList(CComboBox *pDwgList, IDrawing *pIDwg)
{
    if (pDwgList == NULL)
        return;
    if (pIDwg != NULL)
    {
        BSTR bstrName = NULL;
        HRESULT hRes = pIDwg->get_Name(&bstrName);
        if (SUCCEEDED(hRes))
        {
            ASSERT(bstrName != NULL);
            CString strName = bstrName;
            ::SysFreeString(bstrName);
            int iString = pDwgList->AddString(strName);
            pDwgList->SetCurSel(iString);

            pDwgList->SetItemDataPtr(iString, pIDwg);
            pIDwg->AddRef();
        }
    }
}
/////////////////////////////////////////////////////////////////////////////
// CLTSampleDlg message handlers

BOOL CLTSampleDlg::OnInitDialog()
{
    CDialog::OnInitDialog();

    m_wndView.SubclassDlgItem(IDC_TCVIEW, this);

    // Add "About..." menu item to system menu.

    // IDM_ABOUTBOX must be in the system command range.
    ASSERT((IDM_ABOUTBOX & 0xFFF0) == IDM_ABOUTBOX);
    ASSERT(IDM_ABOUTBOX < 0xF000);

    CMenu* pSysMenu = GetSystemMenu(FALSE);
    if (pSysMenu != NULL)
    {
        CString strAboutMenu;
        strAboutMenu.LoadString(IDS_ABOUTBOX);
        if (!strAboutMenu.IsEmpty())
        {
            pSysMenu->AppendMenu(MF_SEPARATOR);
            pSysMenu->AppendMenu(MF_STRING, IDM_ABOUTBOX, strAboutMenu);
        }
    }

    // Set the icon for this dialog.  The framework does this automatically
    //  when the application's main window is not a dialog
    SetIcon(m_hIcon, TRUE);			// Set big icon
    SetIcon(m_hIcon, FALSE);		// Set small icon

    CButton *pButton = (CButton *)GetDlgItem(IDC_LOCALMODE);
    if (pButton != NULL
        && ::IsWindow(pButton->GetSafeHwnd()))
        pButton->SetCheck(1);

    return TRUE;  // return TRUE  unless you set the focus to a control
}

void CLTSampleDlg::OnSysCommand(UINT nID, LPARAM lParam)
{
    if ((nID & 0xFFF0) == IDM_ABOUTBOX)
    {
        CAboutDlg dlgAbout;
        dlgAbout.DoModal();
    }
    else
    {
        CDialog::OnSysCommand(nID, lParam);
    }
}

// If you add a minimize button to your dialog, you will need the code below
//  to draw the icon.  For MFC applications using the document/view model,
//  this is automatically done for you by the framework.

void CLTSampleDlg::OnPaint()
{
    if (IsIconic())
    {
        CPaintDC dc(this); // device context for painting

        SendMessage(WM_ICONERASEBKGND, (WPARAM) dc.GetSafeHdc(), 0);

        // Center icon in client rectangle
        int cxIcon = GetSystemMetrics(SM_CXICON);
        int cyIcon = GetSystemMetrics(SM_CYICON);
        CRect rect;
        GetClientRect(&rect);
        int x = (rect.Width() - cxIcon + 1) / 2;
        int y = (rect.Height() - cyIcon + 1) / 2;

        // Draw the icon
        dc.DrawIcon(x, y, m_hIcon);
    }
    else
    {
        CDialog::OnPaint();
    }
}

// The system calls this to obtain the cursor to display while the user drags
//  the minimized window.
HCURSOR CLTSampleDlg::OnQueryDragIcon()
{
    return (HCURSOR) m_hIcon;
}

// Automation servers should not exit when a user closes the UI
//  if a controller still holds on to one of its objects.  These
//  message handlers make sure that if the proxy is still in use,
//  then the UI is hidden but the dialog remains around if it
//  is dismissed.

void CLTSampleDlg::OnClose()
{
    if (CanExit())
    {
        CDialog::OnClose();

        m_wndView.SetView(NULL);

        CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
        if (pDwgList != NULL)
        {
            int iCount = pDwgList->GetCount();
            for (int iItem = 0; iItem < iCount; iItem++)
            {
                IDrawing *pIDwg = NULL;
                pIDwg = (IDrawing *)pDwgList->GetItemDataPtr(iItem);
                if (pIDwg != NULL)
                    pIDwg->Release();
            }
        }
        if (m_pLocalApp != NULL)
            m_pLocalApp->Release();
        if (m_pInprocApp != NULL)
            m_pInprocApp->Release();
    }
}

void CLTSampleDlg::OnOK()
{
    if (CanExit())
        CDialog::OnOK();
}

void CLTSampleDlg::OnCancel()
{
    if (CanExit())
        CDialog::OnCancel();
}

BOOL CLTSampleDlg::CanExit()
{
    // If the proxy object is still around, then the automation
    //  controller is still holding on to this application.  Leave
    //  the dialog around, but hide its UI.
    if (m_pAutoProxy != NULL)
    {
        ShowWindow(SW_HIDE);
        return FALSE;
    }

    return TRUE;
}

static char BASED_CODE szFilter[] = "TurboCAD Drawing Files (*.tcw)|*.tcw|All Files (*.*)|*.*||";

void CLTSampleDlg::OnMergedrawing()
{
    if (m_pApp == NULL)
    {
        AfxMessageBox(IDS_CREATEAPPFIRST);
        return;
    }

    CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);

        // Pointer to Drawings collection
    Drawings* pDwgs = NULL;

    // Pointer to drawing intrface
    IDrawing* pIDwgOpen = NULL;

    Properties *pProps = NULL;
    Property *pProp = NULL;
    Graphics *pGrs = NULL;

    Properties *pPropsOpen = NULL;
    Property *pPropOpen = NULL;
    Graphics *pGrsOpen = NULL;

    IGraphic *pIGr = NULL;
    BSTR bstrPath = NULL;
//	BSTR bstrMode = NULL;

            // Make a "missing" optional parameter
    VARIANT varMissing;
    varMissing.vt = VT_ERROR;
    varMissing.scode = DISP_E_PARAMNOTFOUND;

    int iSelItem = pDwgList->GetCurSel();
    if (iSelItem >= 0)
    {
        CFileDialog dlg(TRUE, NULL, NULL, OFN_HIDEREADONLY | OFN_OVERWRITEPROMPT, szFilter, this);
        if (dlg.DoModal() != IDOK)
            return;

        // Get the handle to the drawings collection
        TRY
        {

            IDrawing *pIDwg = NULL;
            HRESULT hRes = m_pApp->get_Drawings(&pDwgs);
            CHECK_HRESULT(hRes)

            // Get the file name into a BSTR
            CString strPath = dlg.GetPathName();
            bstrPath = strPath.AllocSysString();

            // Add the drawing to the drawings collection
            hRes = pDwgs->Open(bstrPath, &varMissing, &varMissing, &pIDwgOpen);
            CHECK_HRESULT(hRes)

            pIDwg = (IDrawing *)pDwgList->GetItemDataPtr(iSelItem);
            if (pIDwg != NULL)
            {
//				CString cstrMode("TileMode");
//				bstrMode = cstrMode.AllocSysString();

                COleVariant varPropName("TileMode");
                COleVariant varMode;
                COleVariant varOldMode;

                hRes = pIDwgOpen->get_Properties(&pPropsOpen);
                CHECK_HRESULT(hRes)

                hRes = pPropsOpen->get_Item(&varPropName, &pPropOpen);
                CHECK_HRESULT(hRes)

                hRes = pIDwg->get_Properties(&pProps);
                CHECK_HRESULT(hRes)

                hRes = pProps->get_Item(&varPropName, &pProp);
                CHECK_HRESULT(hRes)

                hRes = pProp->get_Value(0, &varMode);
                CHECK_HRESULT(hRes)

                varOldMode = varMode;

                hRes = pPropOpen->put_Value(0, &varMode);
                CHECK_HRESULT(hRes)

                hRes = pIDwgOpen->get_Graphics(&pGrsOpen);
                CHECK_HRESULT(hRes)

                long lCount = 0;
                hRes = pGrsOpen->get_Count(&lCount);
                CHECK_HRESULT(hRes)

                hRes = pIDwg->get_Graphics(&pGrs);
                CHECK_HRESULT(hRes)

                COleVariant varIndex((const long&)0);

                for (long lItem = 0; lItem < lCount; lItem++)
                {
                    hRes = pGrsOpen->Remove(&varIndex, &pIGr);
                    CHECK_HRESULT(hRes)

                    hRes = pGrs->AddGraphic(pIGr, &varMissing, &varMissing);
                    CHECK_HRESULT(hRes)
                    pIGr->Release();
                    pIGr = NULL;
                }

                pGrsOpen->Release();
                pGrsOpen = NULL;

                pGrs->Release();
                pGrs = NULL;

                // merge next space
                if (varMode.iVal == 0)
                    varMode.iVal = 1;
                else
                    varMode.iVal = 0;

                hRes = pProp->put_Value(0, &varMode);
                CHECK_HRESULT(hRes)

                hRes = pPropOpen->put_Value(0, &varMode);
                CHECK_HRESULT(hRes)

                hRes = pIDwgOpen->get_Graphics(&pGrsOpen);
                CHECK_HRESULT(hRes)

                hRes = pGrsOpen->get_Count(&lCount);
                CHECK_HRESULT(hRes)

                hRes = pIDwg->get_Graphics(&pGrs);
                CHECK_HRESULT(hRes)

                for (lItem = 0; lItem < lCount; lItem++)
                {
                    hRes = pGrsOpen->Remove(&varIndex,&pIGr);
                    CHECK_HRESULT(hRes)

                    hRes = pGrs->AddGraphic(pIGr, &varMissing, &varMissing);
                    CHECK_HRESULT(hRes)
                    pIGr->Release();
                    pIGr = NULL;
                }

            }
        }
        CATCH_ALL(e)
        {
        }
        END_CATCH_ALL
    }
    else
        OnOpendrawing();

    if (bstrPath != NULL)
        ::SysFreeString(bstrPath);
//	if (bstrMode)
//		::SysFreeString(bstrMode);

    if (pIGr != NULL)
        pIGr->Release();

    if (pGrsOpen != NULL)
        pGrsOpen->Release();

    if (pPropOpen != NULL)
        pPropOpen->Release();

    if (pPropsOpen != NULL)
        pPropsOpen->Release();

    if (pGrs != NULL)
        pGrs->Release();

    if (pProp != NULL)
        pProp->Release();

    if (pProps != NULL)
        pProps->Release();

    if (pIDwgOpen != NULL)
    {
        pIDwgOpen->Close(&varMissing, &varMissing, &varMissing);
        pIDwgOpen->Release();
    }

    if (pDwgs != NULL)
        pDwgs->Release();;

}

void CLTSampleDlg::OnOpendrawing()
{
    if (m_pApp == NULL)
    {
        AfxMessageBox(IDS_CREATEAPPFIRST);
        return;
    }
    CFileDialog dlg(TRUE, NULL, NULL, OFN_HIDEREADONLY | OFN_OVERWRITEPROMPT, szFilter, this);
    if (dlg.DoModal() != IDOK)
        return;

    // Pointer to Drawings collection
    Drawings* pDwgs = NULL;

    // Get the handle to the drawings collection
    HRESULT hRes = m_pApp->get_Drawings(&pDwgs);
    if (FAILED(hRes))
    {
        return;
    }

    // Pointer to drawing object
    IDrawing* pIDwg = NULL;

    // Make a "missing" optional parameter
    VARIANT var;
    var.vt = VT_ERROR;
    var.scode = DISP_E_PARAMNOTFOUND;

    // Get the file name into a BSTR
    CString strPath = dlg.GetPathName();
    BSTR bstrPath = strPath.AllocSysString();

    // Add the drawing to the drawings collection
    hRes = pDwgs->Open(bstrPath, &var, &var, &pIDwg);

    // Free the system memory for the BSTR
    ::SysFreeString(bstrPath);

    if (SUCCEEDED(hRes))
    {
        CComboBox* pDwgsList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
        AddDrawingToList(pDwgsList, pIDwg);
        pIDwg->Release();
    }
    else
    {
        // File was not opened.  Maybe the filter gave us a reason.
        CString strDesc("Unknown");

        // Try to get thread-wide error object
        IErrorInfo* pErrorInfo = NULL;
        if (SUCCEEDED(::GetErrorInfo(0, &pErrorInfo)))
        {
            // Try to get description string
            BSTR bstrDesc = NULL;
            if (SUCCEEDED(pErrorInfo->GetDescription(&bstrDesc)))
            {
                strDesc = bstrDesc;
                ::SysFreeString(bstrDesc);
            }
            pErrorInfo->Release();
        }

        // Display failure message
        CString msg = "Could not open '" + strPath + "': " + strDesc;
        MessageBox(msg);
    }

    // Finished with drawings collection, decrement reference count
    pDwgs->Release();

}

void CLTSampleDlg::OnPaste()
{
    CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
    if (pDwgList != NULL)
    {
        int iSelItem = pDwgList->GetCurSel();
        if (iSelItem >= 0)
        {
            IDrawing *pIDwg = (IDrawing *)pDwgList->GetItemDataPtr(iSelItem);
            if (pIDwg != NULL)
            {
                CButton *pPropBt = (CButton *)GetDlgItem(IDC_PASTE);
                pPropBt->EnableWindow(FALSE);

                HRESULT hRes = pIDwg->Paste();
                if (FAILED(hRes))
                    AfxMessageBox(IDS_PASTEFAILED);
                pPropBt->EnableWindow(TRUE);
            }
            else
                AfxMessageBox(IDS_SELECTDRAWINGFIRST);
        }
    }
}

void CLTSampleDlg::OnPropertysymbol()
{
    CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
    if (pDwgList != NULL)
    {
        int iSelItem = pDwgList->GetCurSel();
        if (iSelItem >= 0)
        {
            IDrawing *pIDwg = (IDrawing *)pDwgList->GetItemDataPtr(iSelItem);
            if (pIDwg != NULL)
            {
                CButton *pPropBt = (CButton *)GetDlgItem(IDC_PROPERTYSYMBOL);
                pPropBt->EnableWindow(FALSE);
                Selection *pSelection = NULL;
                HRESULT hRes = pIDwg->get_Selection(&pSelection);
                if (SUCCEEDED(hRes))
                {
                    long lCount;
                    hRes = pSelection->get_Count(&lCount);
                    if (SUCCEEDED(hRes))
                    {
                        if (lCount = 1)
                        {
                            IGraphic *pIGr = NULL;
                            COleVariant varIndex((const long&)0);

                            hRes = pSelection->get_Item(varIndex, &pIGr);
                            if (SUCCEEDED(hRes))
                            {
                                Properties *pProps = NULL;
                                hRes = pIGr->get_Properties(&pProps);
                                if (SUCCEEDED(hRes))
                                {
                                    CPropDialog dlgProp(pProps, this);
                                    if (dlgProp.DoModal() == IDOK)
                                    {
                                    }
                                    pProps->Release();
                                }
                                else
                                    AfxMessageBox(IDS_CANNOTGETCOLLECTION);
                                pIGr->Release();
                            }
                            else
                                AfxMessageBox(IDS_SELECTONESYMBOLONLY);
                        }
                        else
                            AfxMessageBox(IDS_SELECTONESYMBOLONLY);
                    }
                    else
                        AfxMessageBox(IDS_CANNOTGETCOLLECTION);
                    pSelection->Release();
                }
                else
                    AfxMessageBox(IDS_SELECTONESYMBOLONLY);
                pPropBt->EnableWindow(TRUE);
            }
            else
                AfxMessageBox(IDS_SELECTDRAWINGFIRST);
        }
    }
}

void CLTSampleDlg::OnSavedrawing()
{
    CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
    HRESULT hRes = S_OK;
    if (pDwgList != NULL)
    {
        CButton *pSaveBt = (CButton *)GetDlgItem(IDC_SAVEDRAWING);
        pSaveBt->EnableWindow(FALSE);

        int iItem = pDwgList->GetCurSel();
        if (iItem >= 0)
        {
            IDrawing *pIDwg = (IDrawing *)pDwgList->GetItemDataPtr(iItem);
            if (pIDwg != NULL)
            {
                CFileDialog dlg(FALSE, NULL, NULL, OFN_HIDEREADONLY | OFN_OVERWRITEPROMPT, szFilter, this);
                if (dlg.DoModal() == IDOK)
                {
                    // Make a "missing" optional parameter
                    VARIANT var;
                    var.vt = VT_ERROR;
                    var.scode = DISP_E_PARAMNOTFOUND;

                    // Get the file name into a BSTR
                    CString strPath = dlg.GetPathName();
                    BSTR bstrPath = strPath.AllocSysString();

                    HRESULT hRes = pIDwg->SaveAs(bstrPath, &var);

                    // Free the system memory for the BSTR
                    ::SysFreeString(bstrPath);
                }
            }
        }
        else
            AfxMessageBox(IDS_SELECTDRAWINGFIRST);
        pSaveBt->EnableWindow(TRUE);
    }
}

void CLTSampleDlg::OnSelectsymbol()
{
    CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
    HRESULT hRes = S_OK;
    if (pDwgList != NULL)
    {
        CButton *pSelectBt = (CButton *)GetDlgItem(IDC_SELECTSYMBOL);
        if (pSelectBt->IsWindowEnabled())
        {
            int iItem = pDwgList->GetCurSel();
            if (iItem >= 0)
            {
                IDrawing *pIDwg = (IDrawing *)pDwgList->GetItemDataPtr(iItem);
                if (pIDwg != NULL)
                {
                    Selection *pSel = NULL;
                    hRes = pIDwg->get_Selection(&pSel);
                    if (SUCCEEDED(hRes))
                    {
                        pSel->Unselect();
                        pSel->Release();
                    }
                }
                m_wndView.SetSelectMode();
                pSelectBt->EnableWindow(FALSE);
            }
            else
                AfxMessageBox(IDS_SELECTDRAWINGFIRST);
        }
        else
        {
            pSelectBt->EnableWindow(TRUE);
            m_wndView.SetSelectMode();
        }
    }
}

void CLTSampleDlg::OnCreateapp()
{
    CButton *pBtCreate = (CButton *)GetDlgItem(IDC_CREATEAPP);
    if (pBtCreate != NULL
        && ::IsWindow(pBtCreate->GetSafeHwnd()))
        pBtCreate->EnableWindow(FALSE);

    int iLocal = 0;
    CButton *pBtLocal = (CButton *)GetDlgItem(IDC_LOCALMODE);
    if (pBtLocal != NULL
        && ::IsWindow(pBtLocal->GetSafeHwnd()))
        iLocal = pBtLocal->GetCheck();

    int iInproc = 0;
    CButton *pBtInproc = (CButton *)GetDlgItem(IDC_INPROCMODE);
    if (pBtInproc != NULL
        && ::IsWindow(pBtInproc->GetSafeHwnd()))
        iInproc = pBtInproc->GetCheck();

    HRESULT hRes = S_OK;
    if (iLocal == 1)
    {
        ASSERT(iInproc != 1);
        if (m_pLocalApp == NULL)
        {
            IUnknown* pIUnk = NULL;
            hRes = ::GetActiveObject(CLSID_Application, NULL, &pIUnk);
            if (FAILED(hRes))
            {
                hRes = CoCreateInstance(CLSID_Application,	//Class identifier (CLSID) of the object
                                        NULL,	//Object is or isn't part of an aggregate
                                        CLSCTX_LOCAL_SERVER,	//Context for running executable code
                                        IID_IUnknown,	//Interface identifier
                                        (void**)&pIUnk	//Points to requested interface pointer
                );

                if (FAILED(hRes))
                {
                    AfxMessageBox(IDS_COULDNOTCREATELOCALSERVER);
                    return;
                }
            }

            hRes = pIUnk->QueryInterface(IID_IApplication, (void**)&m_pLocalApp);
            pIUnk->Release();
            if (FAILED(hRes))
            {
                AfxMessageBox(IDS_OBJECTISNOTTURBOCADAPPLICATION);
            }
        }
        else
            AfxMessageBox(IDS_LOCALSERVERALREADYRUNNING);
        m_pApp = m_pLocalApp;
    }
    else if (iInproc == 1)
    {
        if (m_pInprocApp == NULL)
        {
            hRes = CoCreateInstance(CLSID_XApplication,	//Class identifier (CLSID) of the object
                                    NULL,	//Object is or isn't part of an aggregate
                                    CLSCTX_INPROC_SERVER,	//Context for running executable code
                                    IID_IApplication,	//Interface identifier
                                    (void**)&m_pInprocApp	//Points to requested interface pointer
            );

            if (FAILED(hRes))
                AfxMessageBox(IDS_COULDNOTCREATEINPROCSERVER);

        }
        else
            AfxMessageBox(IDS_INPROCSERVERALREADYCREATED);
        m_pApp = m_pInprocApp;
    }
    else
        ASSERT(FALSE);

    // uncorrect reference counting of the Selection object
    // in SDK v 4.x - I have to correct it in the my sample
    // when create Application object
    SyncToApplication(m_pApp, TRUE);
    if (m_pApp != NULL)
        AfxMessageBox(IDS_APPCOMPLETE);
}

void CLTSampleDlg::OnSetview()
{

    CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
    if (pDwgList != NULL)
    {
        int iItem = pDwgList->GetCurSel();
        if (iItem >= 0)
        {
            IDrawing *pIDwg = (IDrawing *)pDwgList->GetItemDataPtr(iItem);
            Views *pViews = NULL;
            HRESULT hRes = pIDwg->get_Views(&pViews);
            if (SUCCEEDED(hRes))
            {
                // Pointer to view object
                View* pView = NULL;

                // Make a "missing" optional parameter
                VARIANT var;
                var.vt = VT_ERROR;
                var.scode = DISP_E_PARAMNOTFOUND;

                // Add the view to the collection
                hRes = pViews->Add(&var, &var, &pView);

                if (SUCCEEDED(hRes))
                {
                    // Set up view to be the active view
                    m_wndView.SetView(pView);

                    // Finished with view, decrement reference count
                    pView->Release();
                }

                // Finished with views, decrement reference count
                pViews->Release();
            }
        }
        else
            AfxMessageBox(IDS_SELECTDRAWINGFIRST);
    }
}

void CLTSampleDlg::OnNewdrawing()
{
    if (m_pApp == NULL)
    {
        AfxMessageBox(IDS_CREATEAPPFIRST);
        return;
    }

    Drawings* pDwgs = NULL;

    // Get the handle to the drawings collection
    HRESULT hRes = m_pApp->get_Drawings(&pDwgs);
    if (FAILED(hRes))
    {
        return;
    }

    // Pointer to drawing object
    IDrawing* pIDwg = NULL;

    // Make a "missing" optional parameter
    VARIANT var;
    var.vt = VT_ERROR;
    var.scode = DISP_E_PARAMNOTFOUND;

    // Add the drawing to the drawings collection
    hRes = pDwgs->Add(&var, &pIDwg);
    if (SUCCEEDED(hRes))
    {
        CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
        AddDrawingToList(pDwgList, pIDwg);
        pIDwg->Release();
    }

    // Finished with drawings collection, decrement reference count
    pDwgs->Release();
}

void CLTSampleDlg::OnLocalmode()
{
    m_pApp = m_pLocalApp;
    SyncToApplication(m_pApp);
}

void CLTSampleDlg::OnInprocmode()
{
    m_pApp = m_pInprocApp;
    SyncToApplication(m_pApp);
}

void CLTSampleDlg::OnDrawingProperty()
{
    CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
    if (pDwgList != NULL)
    {
        int iSelItem = pDwgList->GetCurSel();
        if (iSelItem >= 0)
        {
            CButton *pPropBt = (CButton *)GetDlgItem(IDC_DRAWINGPROPERTY);
            pPropBt->EnableWindow(FALSE);
            IDrawing *pIDwg = (IDrawing *)pDwgList->GetItemDataPtr(iSelItem);
            if (pIDwg != NULL)
            {
                Properties *pProps = NULL;
                HRESULT hRes = pIDwg->get_Properties(&pProps);
                if (SUCCEEDED(hRes))
                {
                    CPropDialog dlgProp(pProps, this);
                    if (dlgProp.DoModal() == IDOK)
                    {
                    }
                    pProps->Release();
                }
                else
                    AfxMessageBox(IDS_CANNOTGETCOLLECTION);
            }
            pPropBt->EnableWindow(TRUE);
        }
        else
            AfxMessageBox(IDS_SELECTDRAWINGFIRST);
    }
}

void CLTSampleDlg::OnClosedrawing()
{
    CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
    if (pDwgList != NULL)
    {
        int iSelItem = pDwgList->GetCurSel();
        if (iSelItem >= 0)
        {
            CButton *pPropBt = (CButton *)GetDlgItem(IDC_DRAWINGPROPERTY);
            pPropBt->EnableWindow(FALSE);
            IDrawing *pIDwg = (IDrawing *)pDwgList->GetItemDataPtr(iSelItem);
            if (pIDwg != NULL)
            {
                IDrawing *pIDwgView = m_wndView.GetDrawing();
                if (pIDwgView == pIDwg)
                {
                    m_wndView.SetView(NULL);
                    m_wndView.Invalidate();
                    m_wndView.UpdateWindow();
                    pIDwgView->Release();
                }

                VARIANT var;
                var.vt = VT_ERROR;
                var.scode = DISP_E_PARAMNOTFOUND;
                pIDwg->Close(&var, &var, &var);
                pIDwg->Release();

                pDwgList->DeleteString(iSelItem);
                pDwgList->SetCurSel(iSelItem - 1);
            }
            pPropBt->EnableWindow(TRUE);
        }
        else
            AfxMessageBox(IDS_SELECTDRAWINGFIRST);
    }
}

void CLTSampleDlg::OnExplodesymbol()
{
    CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
    if (pDwgList != NULL)
    {
        int iSelItem = pDwgList->GetCurSel();
        if (iSelItem >= 0)
        {
            IDrawing *pIDwg = (IDrawing *)pDwgList->GetItemDataPtr(iSelItem);
            if (pIDwg != NULL)
            {
                CButton *pExplBt = (CButton *)GetDlgItem(IDC_EXPLODESYMBOL);
                pExplBt->EnableWindow(FALSE);
                Selection *pSelection = NULL;
                HRESULT hRes = pIDwg->get_Selection(&pSelection);
                if (SUCCEEDED(hRes))
                {
                    long lCount;
                    hRes = pSelection->get_Count(&lCount);
                    if (SUCCEEDED(hRes))
                    {
                        if (lCount = 1)
                        {
                            IGraphic *pIGr = NULL;
                            COleVariant varIndex((const long&)0);

                            hRes = pSelection->get_Item(varIndex, &pIGr);
                            if (SUCCEEDED(hRes))
                            {
                                GraphicSet *pSet = NULL;
                                hRes = pIGr->Explode(&pSet);
                                if (SUCCEEDED(hRes))
                                {
                                    pSet->Release();
                                }
                                else
                                    AfxMessageBox(IDS_CANNOTEXPLODEGRAPHIC);
                                pIGr->Release();
                            }
                            else
                                AfxMessageBox(IDS_SELECTONESYMBOLONLY);
                        }
                        else
                            AfxMessageBox(IDS_SELECTONESYMBOLONLY);
                    }
                    else
                        AfxMessageBox(IDS_CANNOTGETCOLLECTION);
                    pSelection->Release();
                }
                else
                    AfxMessageBox(IDS_SELECTONESYMBOLONLY);
                pExplBt->EnableWindow(TRUE);
            }
            else
                AfxMessageBox(IDS_SELECTDRAWINGFIRST);
        }
    }
}

void CLTSampleDlg::OnQuery()
{
    CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
    if (pDwgList != NULL)
    {
        int iSelItem = pDwgList->GetCurSel();
        if (iSelItem >= 0)
        {
            CButton *pQueryBt = (CButton *)GetDlgItem(IDC_QUERY);
            pQueryBt->EnableWindow(FALSE);
            IDrawing *pIDwg = (IDrawing *)pDwgList->GetItemDataPtr(iSelItem);
            if (pIDwg != NULL)
            {
                Graphics *pGrs = NULL;
                HRESULT hRes = pIDwg->get_Graphics(&pGrs);
                if (SUCCEEDED(hRes))
                {
                    CQueryDialog dlgQuery(this);
                    if (dlgQuery.DoModal() == IDOK)
                    {
                        GraphicSet *pGrSet = NULL;
                        BSTR bstrQuery = dlgQuery.m_cstrQueryString.AllocSysString();
                        hRes = pGrs->QuerySet(bstrQuery, &pGrSet);
                        if (SUCCEEDED(hRes))
                        {
                            if (pGrSet != NULL)
                            {
                                hRes = pGrSet->Select();
                                if (SUCCEEDED(hRes))
                                    AfxMessageBox(IDS_QUERYSET_SUCCEEDED);
                                else
                                    AfxMessageBox(IDS_CANNOTSELECTGRAPHIC);
                                pGrSet->Release();
                            }
                            m_wndView.Invalidate();
                            m_wndView.UpdateWindow();
                        }
                        else
                            AfxMessageBox(IDS_QUERYSET_FAILED);
                        ::SysFreeString(bstrQuery);
                    }
                    pGrs->Release();
                }
                else
                    AfxMessageBox(IDS_CANNOTGETCOLLECTION);
            }
            pQueryBt->EnableWindow(TRUE);
        }
        else
            AfxMessageBox(IDS_SELECTDRAWINGFIRST);
    }
}

void CLTSampleDlg::OnCopysymbol()
{
    // TODO: Add your control notification handler code here

}

void CLTSampleDlg::OnAddsymbol()
{
    CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
    if (pDwgList != NULL)
    {
        int iSelItem = pDwgList->GetCurSel();
        if (iSelItem >= 0)
        {
            IDrawing *pIDwg = (IDrawing *)pDwgList->GetItemDataPtr(iSelItem);
            if (pIDwg != NULL)
            {
                CAddSymbolDlg dlgAdd(this);
                if (dlgAdd.DoModal() == IDOK)
                {
                    HRESULT hRes = S_OK;
                    switch (dlgAdd.m_iInsert)
                    {
                        case 0:
                        {
                            RegenMethods *pRegens = NULL;
                            hRes = m_pApp->get_RegenMethods(&pRegens);
                            if (SUCCEEDED(hRes))
                            {
                                CSmartObjectInserDlg dlgInsert(pRegens, this);
                                if (dlgInsert.DoModal())
                                {
                                    VARIANT varMissing;
                                    ::VariantInit(&varMissing);
                                    varMissing.vt = VT_ERROR;
                                    varMissing.scode = DISP_E_PARAMNOTFOUND;

                                    VARIANT varType;
                                    ::VariantInit(&varType);
                                    varType.vt = VT_I4;
                                    varType.lVal = imsiPolyline;

                                    VARIANT varRegenType;
                                    ::VariantInit(&varRegenType);
                                    varRegenType.vt = VT_I4;
                                    varRegenType.lVal = dlgInsert.m_dwID;

                                    IGraphic *pIGr = NULL;
                                    Graphics *pGrs = NULL;
                                    hRes = pIDwg->get_Graphics(&pGrs);
                                    if (SUCCEEDED(hRes))
                                    {

                                        switch (dlgInsert.m_rmType)
                                        {
                                            case imsiAutomation:
                                            {
                                                hRes = pGrs->Add(&varType,
                                                                 &varRegenType,
                                                                 &varMissing,
                                                                 &varMissing,
                                                                 &varMissing,
                                                                 &varMissing,
                                                                 &pIGr);
                                            }
                                            break;
                                            case imsiVTbl:
                                                AfxMessageBox(IDS_NOTIMPLEMENTED);
                                            break;
                                            case imsiScript:
                                                AfxMessageBox(IDS_NOTIMPLEMENTED);
                                            break;
                                        }
                                        if (pIGr != NULL)
                                            pIGr->Release();
                                        pGrs->Release();
                                    }
                                    else
                                        AfxMessageBox(IDS_CANNOTGETCOLLECTION);
                                }
                            }
                            else
                                AfxMessageBox(IDS_CANNOTGETCOLLECTION);
                        }
                        break;
                        case 1:
                        default:
                            AfxMessageBox(IDS_NOTIMPLEMENTED);
                        break;
                    }
                }
            }
            else
                AfxMessageBox(IDS_SELECTDRAWINGFIRST);
        }
        else
            AfxMessageBox(IDS_SELECTDRAWINGFIRST);
    }
}

void CLTSampleDlg::OnDeletesymbol()
{
    CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
    if (pDwgList != NULL)
    {
        int iSelItem = pDwgList->GetCurSel();
        if (iSelItem >= 0)
        {
            IDrawing *pIDwg = (IDrawing *)pDwgList->GetItemDataPtr(iSelItem);
            if (pIDwg != NULL)
            {
                CButton *pPropBt = (CButton *)GetDlgItem(IDC_PROPERTYSYMBOL);
                pPropBt->EnableWindow(FALSE);
                Selection *pSelection = NULL;
                HRESULT hRes = pIDwg->get_Selection(&pSelection);
                if (SUCCEEDED(hRes))
                {
                    long lCount;
                    hRes = pSelection->get_Count(&lCount);
                    if (SUCCEEDED(hRes))
                    {
                        IGraphic *pIGr = NULL;
                        COleVariant varIndex((const long&)0);

                        hRes = pSelection->get_Item(varIndex, &pIGr);
                        if (SUCCEEDED(hRes))
                        {
                            long index;
                            hRes = pIGr->get_Index(&index);
                            if (SUCCEEDED(hRes))
                            {
                                IDispatch *pIDisp = NULL;
                                hRes = pIGr->get_Parent(&pIDisp);
                                if (SUCCEEDED(hRes))
                                {
                                    Graphics *pGrs = NULL;
                                    IDrawing *pIDwg = NULL;
                                    hRes = pIDisp->QueryInterface(IID_IDrawing, (void **)&pIDwg);
                                    if (SUCCEEDED(hRes))
                                        hRes = pIDwg->get_Graphics(&pGrs);
                                    else
                                        hRes = pIDisp->QueryInterface(IID_Graphics, (void **)&pGrs);
                                    pIDisp->Release();
                                    if (SUCCEEDED(hRes))
                                    {
                                        varIndex = index;
                                        IGraphic *pIGrRemoved = NULL;
                                        hRes = pGrs->Remove(&varIndex, &pIGrRemoved);
                                        if (SUCCEEDED(hRes))
                                        {
                                            AfxMessageBox(IDS_SYMBOLREMOVEDFROMDRAWING);
                                            pIGrRemoved->Release();
                                        }
                                        pGrs->Release();
                                    }
                                }
                            }
                            pIGr->Release();
                        }
                        else
                            AfxMessageBox(IDS_SELECTONESYMBOLONLY);
                    }
                    else
                        AfxMessageBox(IDS_CANNOTGETCOLLECTION);
                    pSelection->Release();
                }
                else
                    AfxMessageBox(IDS_SELECTONESYMBOLONLY);
                pPropBt->EnableWindow(TRUE);
            }
        }
        else
            AfxMessageBox(IDS_SELECTDRAWINGFIRST);
    }
}

void CLTSampleDlg::OnAppproperty()
{
    if (m_pApp != NULL)
    {
        CButton *pAppPropsBt = (CButton *)GetDlgItem(IDC_APPPROPERTY);
        if (pAppPropsBt != NULL)
            pAppPropsBt->EnableWindow(FALSE);
        Properties *pProps = NULL;
        HRESULT hRes = m_pApp->get_Properties(&pProps);
        if (SUCCEEDED(hRes))
        {
            CPropDialog dlgProp(pProps, this);
            if (dlgProp.DoModal() == IDOK)
            {
            }
            pProps->Release();
        }
        else
            AfxMessageBox(IDS_CANNOTGETCOLLECTION);
        if (pAppPropsBt != NULL)
            pAppPropsBt->EnableWindow(TRUE);
    }
    else
        AfxMessageBox(IDS_CREATEAPPFIRST);

}

void CLTSampleDlg::OnOptions()
{
    CPropertySheet 	sheet("Options", this);
    CSelOptPage	select;

    select.m_iVersion	= m_iVersion;
    select.m_bTopLevel	= m_wndView.m_varTopLevel.boolVal;
    select.m_bInvisible	= m_wndView.m_varInvisible.boolVal;
    select.m_bSegments	= m_wndView.m_varSegments.boolVal;
    select.m_bArcs		= m_wndView.m_varArcs.boolVal;
    select.m_bTexts		= m_wndView.m_varTexts.boolVal;
    select.m_bBlocks	= m_wndView.m_varBlocks.boolVal;

    sheet.AddPage(&select);
    if (sheet.DoModal() == IDOK)
    {
        m_wndView.m_varTopLevel.boolVal		= select.m_bTopLevel;
        m_wndView.m_varInvisible.boolVal	= select.m_bInvisible;
        m_wndView.m_varSegments.boolVal		= select.m_bSegments;
        m_wndView.m_varArcs.boolVal			= select.m_bArcs;
        m_wndView.m_varTexts.boolVal		= select.m_bTexts;
        m_wndView.m_varBlocks.boolVal		= select.m_bBlocks;
    }
}

void CLTSampleDlg::OnGetblock()
{
    CComboBox *pDwgList = (CComboBox*)GetDlgItem(IDC_DRAWINGLIST);
    if (pDwgList != NULL)
    {
        int iSelItem = pDwgList->GetCurSel();
        if (iSelItem >= 0)
        {
            IDrawing *pIDwg = (IDrawing *)pDwgList->GetItemDataPtr(iSelItem);
            if (pIDwg != NULL)
            {
                CButton *pPropBt = (CButton *)GetDlgItem(IDC_PROPERTYSYMBOL);
                pPropBt->EnableWindow(FALSE);
                Selection *pSelection = NULL;
                HRESULT hRes = pIDwg->get_Selection(&pSelection);
                if (SUCCEEDED(hRes))
                {
                    long lCount;
                    hRes = pSelection->get_Count(&lCount);
                    if (SUCCEEDED(hRes))
                    {
                        if (lCount = 1)
                        {
                            IGraphic *pIGr = NULL;
                            COleVariant varIndex((const long&)0);

                            hRes = pSelection->get_Item(varIndex, &pIGr);
                            if (SUCCEEDED(hRes))
                            {
                                Block *pBlock = NULL;
                                hRes = pIGr->get_Block(&pBlock);
                                if (SUCCEEDED(hRes))
                                {
                                    pBlock->Release();
                                }
                                else
                                    AfxMessageBox(IDS_CANNOTGETBLOCK);
                                pIGr->Release();
                            }
                            else
                                AfxMessageBox(IDS_SELECTONESYMBOLONLY);
                        }
                        else
                            AfxMessageBox(IDS_SELECTONESYMBOLONLY);
                    }
                    else
                        AfxMessageBox(IDS_CANNOTGETCOLLECTION);
                    pSelection->Release();
                }
                else
                    AfxMessageBox(IDS_SELECTONESYMBOLONLY);
                pPropBt->EnableWindow(TRUE);
            }
            else
                AfxMessageBox(IDS_SELECTDRAWINGFIRST);
        }
    }
}


Examples - C++ LineType - LTSampleDlg.h

LTSampleDlg.h

C++ LineType Example

// LTSampleDlg.h : header file
//

#if !defined(AFX_LTSAMPLEDLG_H__3117618E_A076_11D1_B79F_000021452DB6__INCLUDED_)
#define AFX_LTSAMPLEDLG_H__3117618E_A076_11D1_B79F_000021452DB6__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000

class CLTSampleDlgAutoProxy;

/////////////////////////////////////////////////////////////////////////////
// CLTSampleDlg dialog

class CLTSampleDlg : public CDialog
{
    DECLARE_DYNAMIC(CLTSampleDlg);
    friend class CLTSampleDlgAutoProxy;

// Construction
public:
    CLTSampleDlg(CWnd* pParent = NULL);	// standard constructor
    virtual ~CLTSampleDlg();

// Dialog Data
    //{{AFX_DATA(CLTSampleDlg)
    enum { IDD = IDD_LTSAMPLE_DIALOG };
        // NOTE: the ClassWizard will add data members here
    //}}AFX_DATA

    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CLTSampleDlg)
    //}}AFX_VIRTUAL

// Implementation
protected:
    CLTSampleDlgAutoProxy* m_pAutoProxy;
    HICON m_hIcon;
    IApplication *m_pLocalApp;
    IApplication *m_pInprocApp;
    IApplication *m_pApp;
    CViewWnd	  m_wndView;

    int			  m_iVersion;

    void SyncToApplication(IApplication *pApp, BOOL bGetSelection = FALSE);
    void AddDrawingToList(CComboBox *pDwgList, IDrawing *pIDwg);
    BOOL CanExit();

    // Generated message map functions
    //{{AFX_MSG(CLTSampleDlg)
    virtual BOOL OnInitDialog();
    afx_msg void OnSysCommand(UINT nID, LPARAM lParam);
    afx_msg void OnPaint();
    afx_msg HCURSOR OnQueryDragIcon();
    afx_msg void OnClose();
    virtual void OnOK();
    virtual void OnCancel();
    afx_msg void OnMergedrawing();
    afx_msg void OnOpendrawing();
    afx_msg void OnPaste();
    afx_msg void OnPropertysymbol();
    afx_msg void OnSavedrawing();
    afx_msg void OnSelectsymbol();
    afx_msg void OnCreateapp();
    afx_msg void OnSetview();
    afx_msg void OnNewdrawing();
    afx_msg void OnLocalmode();
    afx_msg void OnInprocmode();
    afx_msg void OnDrawingProperty();
    afx_msg void OnClosedrawing();
    afx_msg void OnExplodesymbol();
    afx_msg void OnQuery();
    afx_msg void OnCopysymbol();
    afx_msg void OnAddsymbol();
    afx_msg void OnDeletesymbol();
    afx_msg void OnAppproperty();
    afx_msg void OnOptions();
    afx_msg void OnGetblock();
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_LTSAMPLEDLG_H__3117618E_A076_11D1_B79F_000021452DB6__INCLUDED_)


Examples - C++ LineType - LTSample.h

LTSample.h

C++ LineType Example

// LTSample.h : main header file for the LTSAMPLE application
//

#if !defined(AFX_LTSAMPLE_H__3117618C_A076_11D1_B79F_000021452DB6__INCLUDED_)
#define AFX_LTSAMPLE_H__3117618C_A076_11D1_B79F_000021452DB6__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000

#ifndef __AFXWIN_H__
    #error include 'stdafx.h' before including this file for PCH
#endif

#include "resource.h"		// main symbols

/////////////////////////////////////////////////////////////////////////////
// CLTSampleApp:
// See LTSample.cpp for the implementation of this class
//

class CLTSampleApp : public CWinApp
{
public:
    CLTSampleApp();

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CLTSampleApp)
    public:
    virtual BOOL InitInstance();
    //}}AFX_VIRTUAL

// Implementation

    //{{AFX_MSG(CLTSampleApp)
        // NOTE - the ClassWizard will add and remove member functions here.
        //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

/////////////////////////////////////////////////////////////////////////////

//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_LTSAMPLE_H__3117618C_A076_11D1_B79F_000021452DB6__INCLUDED_)


Examples - C++ LineType - PropDialog.cpp

PropDialog.cpp

C++ LineType Example

// PropDialog.cpp : implementation file
//

#include "stdafx.h"
#include "LTSample.h"
#include "PropDialog.h"
#include "PropModify.h"
#include "AddProperty.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

CString VariantToText(VARIANT *pvarVal, UINT IDS_ARRAY)
{
    CString cstrText;
    if (pvarVal != NULL)
    {

        switch (pvarVal->vt)
        {
            case VT_EMPTY:
                cstrText = "Empty";
            break;
            case VT_I2:
                cstrText.Format("%#X", pvarVal->iVal);
            break;
            case VT_I4:
                cstrText.Format("%#X", pvarVal->lVal);
            break;
            case VT_R4:
                cstrText.Format("%f", pvarVal->fltVal);
            break;
            case VT_R8:
                cstrText.Format("%f", pvarVal->dblVal);
            break;
            case VT_CY:
            {
                COleCurrency currency((const VARIANT&)pvarVal);
                cstrText = currency.Format();
            }
            break;
            case VT_DATE:
            {
                COleDateTime time((const VARIANT&)pvarVal);
                cstrText = time.Format();
            }
            break;
            case VT_BSTR:
                cstrText = pvarVal->bstrVal;
//				::SysFreeString(pvarVal->bstrVal);
            break;
            case VT_BOOL:
                cstrText = pvarVal->bVal ? "TRUE" : "FALSE";
            break;
            case VT_ARRAY | VT_I2:
            case VT_ARRAY | VT_I4:
            case VT_ARRAY | VT_R4:
            case VT_ARRAY | VT_R8:
            case VT_ARRAY | VT_CY:
            case VT_ARRAY | VT_DATE:
            case VT_ARRAY | VT_BSTR:
            case VT_ARRAY | VT_BOOL:
                cstrText.LoadString(IDS_ARRAY);
            break;
            default:
                cstrText = "Unknown type";
        }
    }
    return cstrText;
}

void TextToVariant(CString& cstrText, VARIANT *pvarVal, VARTYPE vt)
{
    if (pvarVal != NULL)
    {
        ::VariantInit(pvarVal);
        switch (vt)
        {
            case VT_I2:
                pvarVal->vt = vt;
                pvarVal->iVal = atoi(cstrText);
            break;
            case VT_I4:
                pvarVal->vt = vt;
                pvarVal->lVal = atol(cstrText);
            break;
            case VT_R4:
                pvarVal->vt = vt;
                pvarVal->fltVal = (float)atof(cstrText);
            break;
            case VT_R8:
                pvarVal->vt = vt;
                pvarVal->dblVal = atof(cstrText);
            break;
            case VT_CY:
            {
                COleCurrency currency;
                if (currency.ParseCurrency(cstrText))
                {
                    pvarVal->vt = vt;
                    pvarVal->cyVal = currency;
                }
            }
            break;
            case VT_DATE:
            {
                COleDateTime time;
                if (time.ParseDateTime(cstrText));
                {
                    pvarVal->vt = vt;
                    pvarVal->date = time;
                }
            }
            break;
            case VT_BSTR:
                pvarVal->vt = vt;
                pvarVal->bstrVal = cstrText.AllocSysString();
            break;
            case VT_BOOL:
                if (cstrText.CompareNoCase("True"))
                {
                    pvarVal->vt = vt;
                    pvarVal->bVal = TRUE;
                }
                else if (cstrText.CompareNoCase("False"))
                {
                    pvarVal->vt = vt;
                    pvarVal->bVal = FALSE;
                }
            break;
        }
    }
}

CString VartypeToText(SHORT vt)
{
    CString cstrText;
    SHORT vtL = vt & 0x0FFF;
    SHORT vtH = vt & 0xF000;

    switch (vtH)
    {
        case VT_RESERVED:
            cstrText = "VT_RESERVED";
        break;
        case VT_BYREF:
            cstrText = "VT_BYREF";
        break;
        case VT_ARRAY:
            cstrText = "VT_ARRAY";
        break;
    }

    if (!cstrText.IsEmpty())
        cstrText += " | ";

    switch (vtL)
    {
        case VT_EMPTY:
            cstrText += "VT_EMPTY";
        break;
        case VT_NULL:
            cstrText += "VT_NULL";
        break;
        case VT_I2:
            cstrText += "VT_I2";
        break;
        case VT_I4:
            cstrText += "VT_I4";
        break;
        case VT_R4:
            cstrText += "VT_R4";
        break;
        case VT_R8:
            cstrText += "VT_R8";
        break;
        case VT_CY:
            cstrText += "VT_CY";
        break;
        case VT_DATE:
            cstrText += "VT_DATE";
        break;
        case VT_BSTR:
            cstrText += "VT_BSTR";
        break;
        case VT_DISPATCH:
            cstrText += "VT_DISPATCH";
        break;
        case VT_ERROR:
            cstrText += "VT_ERROR";
        break;
        case VT_BOOL:
            cstrText += "VT_BOOL";
        break;
        case VT_VARIANT:
            cstrText += "VT_VARIANT";
        break;
        case VT_UNKNOWN:
            cstrText += "VT_UNKNOWN";
        break;
        case VT_UI1:
            cstrText += "VT_UI1";
        break;
    }
    return cstrText;
}

VARTYPE TextToVartype(CString& cstrText)
{
    VARTYPE vt = VT_EMPTY;

    if (cstrText.Find("VT_RESERVED") >= 0)
        vt |= VT_RESERVED;

    if (cstrText.Find("VT_BYREF") >= 0)
        vt |= VT_BYREF;

    if (cstrText.Find("VT_ARRAY") >= 0)
        vt |= VT_ARRAY;

    if (cstrText.Find("VT_EMPTY") >= 0)
        vt |= VT_EMPTY;

    if (cstrText.Find("VT_NULL") >= 0)
        vt |= VT_NULL;

    if (cstrText.Find("VT_I2") >= 0)
        vt |= VT_I2;

    if (cstrText.Find("VT_I4") >= 0)
        vt |= VT_I4;

    if (cstrText.Find("VT_R4") >= 0)
        vt |= VT_R4;

    if (cstrText.Find("VT_R8") >= 0)
        vt |= VT_R8;

    if (cstrText.Find("VT_CY") >= 0)
        vt |= VT_CY;

    if (cstrText.Find("VT_DATE") >= 0)
        vt |= VT_DATE;

    if (cstrText.Find("VT_BSTR") >= 0)
        vt |= VT_BSTR;

    if (cstrText.Find("VT_DISPATCH") >= 0)
        vt |= VT_DISPATCH;

    if (cstrText.Find("VT_ERROR") >= 0)
        vt |= VT_ERROR;

    if (cstrText.Find("VT_BOOL") >= 0)
        vt |= VT_BOOL;

    if (cstrText.Find("VT_VARIANT") >= 0)
        vt |= VT_VARIANT;

    if (cstrText.Find("VT_UNKNOWN") >= 0)
        vt |= VT_UNKNOWN;

    if (cstrText.Find("VT_UI1") >= 0)
        vt |= VT_UI1;

    return vt;
}

/////////////////////////////////////////////////////////////////////////////
// CPropDialog dialog

CPropDialog::CPropDialog(Properties *pProps, CWnd* pParent /*=NULL*/)
    : CDialog(CPropDialog::IDD, pParent)
{
    //{{AFX_DATA_INIT(CPropDialog)
        // NOTE: the ClassWizard will add member initialization here
    //}}AFX_DATA_INIT
    m_pProps = pProps;
}

void CPropDialog::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CPropDialog)
        // NOTE: the ClassWizard will add DDX and DDV calls here
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CPropDialog, CDialog)
    //{{AFX_MSG_MAP(CPropDialog)
    ON_BN_CLICKED(IDC_MODIFY, OnModify)
    ON_BN_CLICKED(IDC_NEW, OnAdd)
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CPropDialog message handlers
#define W_COLUMN	20

#define IND_SUBITEMINDEX	0
#define IND_SUBITEMID		1
#define IND_SUBITEMNAME		2
#define IND_SUBITEMREADONLY	3
#define IND_SUBITEMTYPE		4
#define IND_SUBITEMVALUE	5

#define IND_COLUMNINDEX		0
#define IND_COLUMNID		1
#define IND_COLUMNAME		2
#define IND_COLUMNREADONLY	3
#define IND_COLUMNTYPE		4
#define IND_COLUMNVALUE		5

BOOL CPropDialog::OnInitDialog()
{
    CDialog::OnInitDialog();

    CListCtrl *pPropsList = (CListCtrl *)GetDlgItem(IDC_PROPERTYLIST);

    if (pPropsList != NULL)
    {
        LV_COLUMN lvcolumn;
        lvcolumn.mask = LVCF_FMT | LVCF_SUBITEM | LVCF_TEXT | LVCF_WIDTH;
        lvcolumn.fmt = LVCFMT_LEFT;

        CString sResString;
        sResString.LoadString(IDS_PROPERTY_INDEX);
        lvcolumn.pszText = (LPTSTR)(LPCTSTR)sResString;

        lvcolumn.iSubItem = IND_SUBITEMINDEX;
        lvcolumn.cx = W_COLUMN * 4;
        pPropsList->InsertColumn(IND_COLUMNINDEX, &lvcolumn);  // assumes return value is OK.

        sResString.LoadString(IDS_PROPERTY_ID);
        lvcolumn.pszText = (LPTSTR)(LPCTSTR)sResString;
        lvcolumn.iSubItem = IND_SUBITEMID;
        lvcolumn.cx = W_COLUMN * 3;
        pPropsList->InsertColumn(IND_COLUMNID, &lvcolumn);  // assumes return value is OK.

        sResString.LoadString(IDS_PROPERTY_NAME);
        lvcolumn.pszText = (LPTSTR)(LPCTSTR)sResString;
        lvcolumn.cx = W_COLUMN * 5;
        lvcolumn.iSubItem = IND_SUBITEMNAME;
        pPropsList->InsertColumn(IND_COLUMNAME, &lvcolumn);  // assumes return value is OK.

        sResString.LoadString(IDS_PROPERTY_READONLY);
        lvcolumn.pszText = (LPTSTR)(LPCTSTR)sResString;
        lvcolumn.cx = W_COLUMN * 4;
        lvcolumn.iSubItem = IND_SUBITEMREADONLY;
        pPropsList->InsertColumn(IND_COLUMNREADONLY, &lvcolumn);  // assumes return value is OK.

        sResString.LoadString(IDS_PROPERTY_TYPE);
        lvcolumn.pszText = (LPTSTR)(LPCTSTR)sResString;
        lvcolumn.cx = W_COLUMN * 4;
        lvcolumn.iSubItem = IND_SUBITEMTYPE;
        pPropsList->InsertColumn(IND_COLUMNTYPE, &lvcolumn);  // assumes return value is OK.

        sResString.LoadString(IDS_PROPERTY_VALUE);
        lvcolumn.pszText = (LPTSTR)(LPCTSTR)sResString;
        lvcolumn.cx = W_COLUMN * 4;
        lvcolumn.iSubItem = IND_SUBITEMVALUE;
        pPropsList->InsertColumn(IND_COLUMNVALUE, &lvcolumn);  // assumes return value is OK.
    }

    if (m_pProps != NULL)
    {

        long lCount = 0;
        HRESULT hRes = m_pProps->get_Count(&lCount);
        if (SUCCEEDED(hRes))
        {

            Property *pProp = NULL;
            CString cstrText;
            BSTR bstrVal = NULL;
            long lVal = 0;
            long lID = 0;
            BOOL bVal = FALSE;
            COleVariant *pvarVal;
            SHORT iVal = 0;

            VARIANT varIndex;
            ::VariantInit(&varIndex);
            varIndex.vt = VT_I4;

            LV_ITEM			lvitem;
            int				index = 0;

            for (long iItem = 0; iItem < lCount; iItem++)
            {

                varIndex.lVal = iItem;
                hRes = m_pProps->get_Item(&varIndex, &pProp);
                if (SUCCEEDED(hRes))
                {
                    ASSERT(pProp != NULL);

                    lvitem.mask = LVIF_TEXT;
                    lvitem.iItem = index;

                    hRes = pProp->get_ID(&lID);
                    if (SUCCEEDED(hRes))
                    {
                        lvitem.iSubItem = IND_SUBITEMINDEX;
                        hRes = pProp->get_Index(&lVal);
                        if (SUCCEEDED(hRes))
                            cstrText.Format("%d", lVal);
                        else
                            cstrText = "?";
                        lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;
                        index = pPropsList->InsertItem(&lvitem);
                        ASSERT(index >= 0);

                        lvitem.iSubItem = IND_SUBITEMID;
                        cstrText.Format("%d", lID);
                        lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;
                        VERIFY(pPropsList->SetItem(&lvitem));

                        hRes = pProp->get_Name(&bstrVal);
                        ASSERT(SUCCEEDED(hRes));
                        lvitem.iSubItem = IND_SUBITEMNAME;
                        cstrText = bstrVal;
                        ::SysFreeString(bstrVal);
                        lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;
                        VERIFY(pPropsList->SetItem(&lvitem));

                        hRes = pProp->get_ReadOnly(&iVal);
                        lvitem.iSubItem = IND_SUBITEMREADONLY;
                        lvitem.pszText = bVal ? "r-" : "rw";
                        VERIFY(pPropsList->SetItem(&lvitem));

                        hRes = pProp->get_Type(&iVal);
                        lvitem.iSubItem = IND_SUBITEMTYPE;
                        cstrText = VartypeToText(iVal);
                        lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;
                        VERIFY(pPropsList->SetItem(&lvitem));

                        pvarVal = new COleVariant();
                        hRes = pProp->get_Value(0, pvarVal);
                        lvitem.iSubItem = IND_SUBITEMVALUE;
                        cstrText = VariantToText(pvarVal, IDS_SOURCE);
                        lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;
                        VERIFY(pPropsList->SetItem(&lvitem));

                        VERIFY(index == m_arrVal.Add(pvarVal));
                        VERIFY(pPropsList->SetItemData(index, (DWORD)pProp));
                        index++;
                    }
                    else
                        pProp->Release();
                }
            }
        }
    }

    return TRUE;  // return TRUE unless you set the focus to a control
                  // EXCEPTION: OCX Property Pages should return FALSE
}

void CPropDialog::OnModify()
{
    CListCtrl *pPropsList = (CListCtrl *)GetDlgItem(IDC_PROPERTYLIST);
    if (pPropsList != NULL)
    {
        int iSelItem = pPropsList->GetNextItem(-1, LVNI_SELECTED);
        if (iSelItem >= 0)
        {
//			Property *pProp = (Property *)pPropsList->GetItemData(iSelItem);
            COleVariant *pvarVal = (COleVariant *)m_arrVal.GetAt(iSelItem);
            if (pvarVal != NULL)
            {
                CString cstrName = pPropsList->GetItemText(iSelItem, IND_SUBITEMNAME);
                CString cstrType = pPropsList->GetItemText(iSelItem, IND_SUBITEMTYPE);

                CPropModify dlgModify(pvarVal, cstrName, cstrType, this);
                if (dlgModify.DoModal() == IDOK)
                {
                    CString cstrText = VariantToText(&(dlgModify.m_varVal), IDS_MODIFIED);
                    VERIFY(SUCCEEDED(::VariantCopyInd(pvarVal, dlgModify.m_varVal)));
                    LV_ITEM			lvitem;
                    lvitem.mask = LVIF_TEXT;
                    lvitem.iItem = iSelItem;
                    lvitem.iSubItem = IND_SUBITEMVALUE;
                    lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;

                    VERIFY(pPropsList->SetItem(&lvitem));
                    pPropsList->Update(iSelItem);
                }
            }
        }

    }
}

void CPropDialog::OnCancel()
{
    // TODO: Add extra cleanup here

    CDialog::OnCancel();
}

void CPropDialog::OnOK()
{
    CListCtrl *pPropsList = (CListCtrl *)GetDlgItem(IDC_PROPERTYLIST);
    if (pPropsList != NULL)
    {
        ASSERT(::IsWindow(pPropsList->GetSafeHwnd()));
        Property *pProp = NULL;
        int iCount = pPropsList->GetItemCount();
        for (int iItem = 0; iItem < iCount; iItem++)
        {
            COleVariant *pvar = (COleVariant *)m_arrVal.GetAt(iItem);
            pProp = (Property *)pPropsList->GetItemData(iItem);
            if (pProp == NULL)
            {
                CString cstrName = pPropsList->GetItemText(iItem, IND_SUBITEMNAME);
                BSTR bstrName = cstrName.AllocSysString();

                COleVariant varReadOnly;
                CString cstrReadOnly = pPropsList->GetItemText(iItem, IND_SUBITEMREADONLY);
                TextToVariant(cstrReadOnly, &varReadOnly, VT_BOOL);

                COleVariant varMissing;
                varMissing.vt = VT_ERROR;
                varMissing.scode = DISP_E_PARAMNOTFOUND;

                HRESULT hRes = m_pProps->Add(bstrName,
                                             pvar,
                                             varReadOnly,
                                             &varMissing,
                                             &pProp);
                ::SysFreeString(bstrName);
                if (SUCCEEDED(hRes))
                    pProp->Release();
                else
                {
                    CString cstrError;
                    cstrError.Format(IDS_CANNOTADDPROPERTY, cstrName);
                    AfxMessageBox(cstrError);
                }
            }
            else
                pProp->put_Value(0,pvar);
        }
    }
    else
        ASSERT(FALSE);
    CDialog::OnOK();
}

BOOL CPropDialog::DestroyWindow()
{
    CListCtrl *pPropsList = (CListCtrl *)GetDlgItem(IDC_PROPERTYLIST);
    if (pPropsList != NULL)
    {
        ASSERT(::IsWindow(pPropsList->GetSafeHwnd()));
        Property *pProp = NULL;
        COleVariant *pvarVal;
        int iCount = pPropsList->GetItemCount();
        for (int iItem = 0; iItem < iCount; iItem++)
        {
            pProp = (Property *)pPropsList->GetItemData(iItem);
            if (pProp != NULL)
                pProp->Release();
            pvarVal = (COleVariant *)m_arrVal.GetAt(iItem);
            if (pvarVal != NULL)
                delete pvarVal;
        }
    }
    else
        ASSERT(FALSE);

    return CDialog::DestroyWindow();
}

void CPropDialog::OnAdd()
{
    CAddProperty dlgAdd;
    if (dlgAdd.DoModal())
    {
        CListCtrl *pPropsList = (CListCtrl *)GetDlgItem(IDC_PROPERTYLIST);

        int iCount = pPropsList->GetItemCount();
        LV_ITEM			lvitem;
        lvitem.mask = LVIF_TEXT;
        lvitem.iItem = iCount;

        lvitem.iSubItem = IND_SUBITEMINDEX;
        CString cstrText = "?";
        lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;
        int index = pPropsList->InsertItem(&lvitem);
        ASSERT(index >= 0);

        lvitem.iSubItem = IND_SUBITEMID;
        cstrText = "?";
        lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;
        VERIFY(pPropsList->SetItem(&lvitem));

        lvitem.iSubItem = IND_SUBITEMNAME;
        cstrText = dlgAdd.m_cstrName;
        lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;
        VERIFY(pPropsList->SetItem(&lvitem));

        lvitem.iSubItem = IND_SUBITEMREADONLY;
        lvitem.pszText = dlgAdd.m_bReadOnly ? "r-" : "rw";
        VERIFY(pPropsList->SetItem(&lvitem));

        lvitem.iSubItem = IND_SUBITEMTYPE;
        cstrText = dlgAdd.m_cstrType;
        lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;
        VERIFY(pPropsList->SetItem(&lvitem));

        COleVariant *pvarVal = new COleVariant();
        pvarVal->vt = TextToVartype(cstrText);
        lvitem.iSubItem = IND_SUBITEMVALUE;
        cstrText = VariantToText(pvarVal, IDS_SOURCE);
        lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;
        VERIFY(pPropsList->SetItem(&lvitem));
        VERIFY(index == m_arrVal.Add(pvarVal));
    }
}


Examples - C++ LineType - PropDialog.h

PropDialog.h

C++ LineType Example

#if !defined(AFX_PROPDIALOG_H__430FB7B3_A088_11D1_B79F_000021452DB6__INCLUDED_)
#define AFX_PROPDIALOG_H__430FB7B3_A088_11D1_B79F_000021452DB6__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000
// PropDialog.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CPropDialog dialog

class CPropDialog : public CDialog
{
// Construction
public:
    CPropDialog(Properties *pProps, CWnd* pParent = NULL);   // standard constructor
    Properties *m_pProps;

// Dialog Data
    //{{AFX_DATA(CPropDialog)
    enum { IDD = IDD_PROPERTY };
    //}}AFX_DATA

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CPropDialog)
    public:
    virtual BOOL DestroyWindow();
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
    CPtrArray m_arrVal;
protected:

    // Generated message map functions
    //{{AFX_MSG(CPropDialog)
    virtual BOOL OnInitDialog();
    afx_msg void OnModify();
    virtual void OnCancel();
    virtual void OnOK();
    afx_msg void OnAdd();
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_PROPDIALOG_H__430FB7B3_A088_11D1_B79F_000021452DB6__INCLUDED_)


Examples - C++ LineType - PropModify.cpp

PropModify.cpp

C++ LineType Example

// propmodify.cpp : implementation file
//

#include "stdafx.h"
#include "LTSample.h"
#include "propmodify.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

#define W_EDIT	50
#define H_EDIT	20

void PutVoidToVariant(VARIANT& varVal, void* pvoid)
{
    switch (varVal.vt)
    {
        case VT_I2:
            varVal.iVal = *((SHORT *)pvoid);
        break;
        case VT_I4:
            varVal.lVal = *((long *)pvoid);
        break;
        case VT_R4:
            varVal.fltVal = *((float *)pvoid);
        break;
        case VT_R8:
            varVal.dblVal = *((double *)pvoid);
        break;
        case VT_CY:
            varVal.cyVal = *((CY *)pvoid);
        break;
        case VT_DATE:
            varVal.date = *((DATE *)pvoid);
        break;
        case VT_BSTR:
            varVal.bstrVal = *((BSTR *)pvoid);
        break;
        case VT_BOOL:
            varVal.boolVal = *((BOOL *)pvoid);
        break;
        default:
            varVal.vt = VT_EMPTY;
    }
}

void PutVariantToVoid(void* pvoid, VARIANT& varVal)
{
    switch (varVal.vt)
    {
        case VT_I2:
            *((SHORT *)pvoid) = varVal.iVal;
        break;
        case VT_I4:
            *((long *)pvoid) = varVal.lVal;
        break;
        case VT_R4:
            *((float *)pvoid) = varVal.fltVal;
        break;
        case VT_R8:
            *((double *)pvoid) = varVal.dblVal;
        break;
        case VT_CY:
            *((CY *)pvoid) = varVal.cyVal;
        break;
        case VT_DATE:
            *((DATE *)pvoid) = varVal.date;
        break;
        case VT_BSTR:
            *((BSTR *)pvoid) = varVal.bstrVal;
        break;
        case VT_BOOL:
            *((BOOL *)pvoid) = varVal.boolVal;
        break;
        default:
            ASSERT(FALSE);
    }
}

void AFXAPI DDX_Text(CDataExchange* pDX, int nIDC, VARIANT& varVal)
{
    switch (varVal.vt)
    {
        case VT_I2:
            DDX_Text(pDX, nIDC, varVal.iVal);
        break;
        case VT_I4:
            DDX_Text(pDX, nIDC, varVal.lVal);
        break;
        case VT_R4:
            DDX_Text(pDX, nIDC, varVal.fltVal);
        break;
        case VT_R8:
            DDX_Text(pDX, nIDC, varVal.dblVal);
        break;
        case VT_CY:
        {
            COleCurrency cy(varVal.cyVal);
            DDX_Text(pDX, nIDC, cy);
            if (pDX->m_bSaveAndValidate)
                varVal.cyVal = cy;
        }
        break;
        case VT_DATE:
        {
            COleDateTime date(varVal.date);
            DDX_Text(pDX, nIDC, date);
            if (pDX->m_bSaveAndValidate)
                varVal.date = date;
        }
        break;
        case VT_BSTR:
        {
            CString cstrVal(varVal.bstrVal);
            DDX_Text(pDX, nIDC, cstrVal);

            if (pDX->m_bSaveAndValidate)
            {
                if (varVal.bstrVal != NULL)
                    SysFreeString(varVal.bstrVal);
                varVal.bstrVal = cstrVal.AllocSysString();
            }
        }
        break;
        case VT_BOOL:
        {
            CString cstrText(varVal.boolVal ? "True" : "False");

            DDX_Text(pDX, nIDC, cstrText);

            if (pDX->m_bSaveAndValidate)
            {
                if (cstrText.CompareNoCase("True") == 0)
                    varVal.boolVal = 1;
                else
                {
                    if (cstrText.CompareNoCase("False"))
                        varVal.boolVal = 0;
                    else
                        pDX->Fail();
                }
            }
        }
        break;
        default:
            varVal.vt = VT_EMPTY;
            pDX->Fail();
    }
}

/////////////////////////////////////////////////////////////////////////////
// CPropModify dialog

CPropModify::CPropModify(COleVariant *pvarVal, LPCTSTR cszName, LPCTSTR cszType, CWnd* pParent /*=NULL*/)
    : CDialog(CPropModify::IDD, pParent)
{
    m_cstrName = cszName;
    m_cstrType = cszType;
    ::VariantCopyInd(m_varVal, pvarVal);
    m_bInitDone = FALSE;
    //{{AFX_DATA_INIT(CPropModify)
        // NOTE: the ClassWizard will add member initialization here
    //}}AFX_DATA_INIT
}

void CPropModify::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    if (m_bInitDone)
    {
        int iUpper = m_arrWnd.GetUpperBound();
        CEdit *pEdit = NULL;
        UINT IDC_EDIT = IDC_VAL + 1;
        if (m_varVal.vt & VT_ARRAY)
        {
            long lLBound, lUBound;
            VARIANT varVal;
            ::VariantInit(&varVal);

            varVal.vt = m_varVal.vt & ~VT_ARRAY;
            UINT nSize = SafeArrayGetElemsize(m_varVal.parray);
            void *pelem = (void *)new BYTE[nSize];

            HRESULT  hRes = SafeArrayGetLBound(m_varVal.parray, 1, &lLBound);
            ASSERT(SUCCEEDED(hRes));
            hRes = SafeArrayGetUBound(m_varVal.parray, 1, &lUBound);
            ASSERT(SUCCEEDED(hRes));
            for (long lItem = lLBound; lItem <= lUBound; lItem++)
            {
                if (pDX->m_bSaveAndValidate)
                {
                    DDX_Text(pDX, IDC_EDIT, varVal);
                    PutVariantToVoid(pelem, varVal);
                    VERIFY(SUCCEEDED(SafeArrayPutElement(m_varVal.parray, &lItem, pelem)));
                }
                else
                {
                    if (SUCCEEDED(SafeArrayGetElement(m_varVal.parray, &lItem, pelem)))
                    {
                        PutVoidToVariant(varVal, pelem);
                        DDX_Text(pDX, IDC_EDIT, varVal);
                    }
                }

                IDC_EDIT++;
            }
            delete[] pelem;

        }
        else
        {
            DDX_Text(pDX, IDC_EDIT, m_varVal);
        }
    }
}

BEGIN_MESSAGE_MAP(CPropModify, CDialog)
    //{{AFX_MSG_MAP(CPropModify)
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CPropModify message handlers

BOOL CPropModify::OnInitDialog()
{
    CDialog::OnInitDialog();

    CStatic *pWnd = (CStatic *)GetDlgItem(IDC_NAME);
    if (pWnd != NULL)
    {
        pWnd->SetWindowText(m_cstrName);
    }

    pWnd = (CStatic *)GetDlgItem(IDC_TYPE);
    if (pWnd != NULL)
    {
        pWnd->SetWindowText(m_cstrType);
    }

    CRect rect;
    pWnd = (CStatic *)GetDlgItem(IDC_VAL);
    pWnd->GetWindowRect(&rect);
    ScreenToClient(&rect);

    CRect rectEdit;
    CEdit *pEdit = NULL;

    rectEdit.top = rect.bottom + 2;
    rectEdit.bottom = rectEdit.top + H_EDIT;
    UINT IDC_EDIT = IDC_VAL + 1;

    if (m_varVal.vt & VT_ARRAY)
    {
        int dx = 0, dy = 0;
        UINT nDim = SafeArrayGetDim(m_varVal.parray);
        if (nDim > 1)
        {
            AfxMessageBox("IDS_CANNOTTPROCESSPROPERTYDATA");
            return FALSE;
        }

        long lLBound, lUBound;
        long max_dx = 0;

        HRESULT hRes = SafeArrayGetLBound(m_varVal.parray, 1, &lLBound);
        ASSERT(SUCCEEDED(hRes));
        hRes = SafeArrayGetUBound(m_varVal.parray, 1, &lUBound);
        ASSERT(SUCCEEDED(hRes));
        rectEdit.left = rect.left;
        for (long lItem = lLBound; lItem <= lUBound; lItem++)
        {
            pEdit = new CEdit();
            rectEdit.right = rectEdit.left + W_EDIT;
            pEdit->Create(WS_CHILD
                          | WS_VISIBLE
                          | WS_BORDER
                          | ES_AUTOHSCROLL
                          | ES_LEFT,
                          rectEdit,
                          this,
                          IDC_EDIT);

            pEdit->SetFont(GetFont());
            m_arrWnd.Add(pEdit);
            rectEdit.left = rectEdit.right + 2;
            IDC_EDIT++;
        }

    }
    else
    {
        rectEdit.left = rect.left + (rect.Width() - W_EDIT) / 2;
        rectEdit.right = rectEdit.left + W_EDIT;

        pEdit = new CEdit();
        pEdit->Create(WS_CHILD
                      | WS_VISIBLE
                      | WS_BORDER
                      | ES_AUTOHSCROLL
                      | ES_LEFT,
                      rectEdit,
                      this,
                      IDC_EDIT);

        pEdit->SetFont(GetFont());

        m_arrWnd.Add(pEdit);
    }
    m_bInitDone = TRUE;
    UpdateData(FALSE);

    return TRUE;  // return TRUE unless you set the focus to a control
                  // EXCEPTION: OCX Property Pages should return FALSE
}

BOOL CPropModify::DestroyWindow()
{
    int iUpper = m_arrWnd.GetUpperBound();
    CEdit *pEdit = NULL;
    for (int iItem = 0; iItem <= iUpper; iItem ++)
    {
        pEdit = (CEdit *)m_arrWnd.GetAt(iItem);
        m_arrWnd.SetAt(iItem, NULL);

        if (pEdit != NULL)
            delete pEdit;

        pEdit = NULL;
    }

    return CDialog::DestroyWindow();
}


Examples - C++ LineType - PropModify.h

PropModify.h

C++ LineType Example

#if !defined(AFX_PROPMODIFY_H__430FB7B4_A088_11D1_B79F_000021452DB6__INCLUDED_)
#define AFX_PROPMODIFY_H__430FB7B4_A088_11D1_B79F_000021452DB6__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000
/////////////////////////////////////////////////////////////////////////////
// CPropModify dialog

class CPropModify : public CDialog
{
// Construction
public:
    CPropModify(COleVariant *pvarVal, LPCTSTR cszName, LPCTSTR cszType, CWnd* pParent = NULL);   // standard constructor

// Dialog Data
    //{{AFX_DATA(CPropModify)
    enum { IDD = IDD_MODIFY };
        // NOTE: the ClassWizard will add data members here
    //}}AFX_DATA

    COleVariant	m_varVal;
// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CPropModify)
    public:
    virtual BOOL DestroyWindow();
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:
//	Property	*m_pProp;
    CString		m_cstrName;
    CString		m_cstrType;
    CPtrArray	m_arrWnd;
    int			m_index;
    BOOL		m_bInitDone;
    // Generated message map functions
    //{{AFX_MSG(CPropModify)
    virtual BOOL OnInitDialog();
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};
//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_PROPMODIFY_H__430FB7B4_A088_11D1_B79F_000021452DB6__INCLUDED_)


Examples - C++ LineType - QueryDialog.cpp

QueryDialog.cpp

C++ LineType Example

// QueryDialog.cpp : implementation file
//

#include "stdafx.h"
#include "ltsample.h"
#include "QueryDialog.h"
#include "QueryHelpDlg.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CQueryDialog dialog

CQueryDialog::CQueryDialog(CWnd* pParent /*=NULL*/)
    : CDialog(CQueryDialog::IDD, pParent)
{
    //{{AFX_DATA_INIT(CQueryDialog)
    m_cstrQueryString = _T("");
    //}}AFX_DATA_INIT
}

void CQueryDialog::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CQueryDialog)
    DDX_Text(pDX, IDC_EDIT_QUERYSTRING, m_cstrQueryString);
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CQueryDialog, CDialog)
    //{{AFX_MSG_MAP(CQueryDialog)
    ON_BN_CLICKED(IDC_HELPQUERY, OnHelpquery)
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CQueryDialog message handlers

void CQueryDialog::OnHelpquery()
{
    CQueryHelpDlg dlgHlp(this);
    dlgHlp.DoModal();
}


Examples - C++ LineType - QueryDialog.h

QueryDialog.h

C++ LineType Example

#if !defined(AFX_QUERYDIALOG_H__AC0EA555_AE8F_11D1_B7C4_000021452DB6__INCLUDED_)
#define AFX_QUERYDIALOG_H__AC0EA555_AE8F_11D1_B7C4_000021452DB6__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000
// QueryDialog.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CQueryDialog dialog

class CQueryDialog : public CDialog
{
// Construction
public:
    CQueryDialog(CWnd* pParent = NULL);   // standard constructor

// Dialog Data
    //{{AFX_DATA(CQueryDialog)
    enum { IDD = IDD_QUERY };
    CString	m_cstrQueryString;
    //}}AFX_DATA

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CQueryDialog)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:

    // Generated message map functions
    //{{AFX_MSG(CQueryDialog)
    afx_msg void OnHelpquery();
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_QUERYDIALOG_H__AC0EA555_AE8F_11D1_B7C4_000021452DB6__INCLUDED_)


Examples - C++ LineType - QueryHelpDlg.cpp

QueryHelpDlg.cpp

C++ LineType Example

// QueryHelpDlg.cpp : implementation file
//

#include "stdafx.h"
#include "ltsample.h"
#include "QueryHelpDlg.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CQueryHelpDlg dialog

CQueryHelpDlg::CQueryHelpDlg(CWnd* pParent /*=NULL*/)
    : CDialog(CQueryHelpDlg::IDD, pParent)
{
    //{{AFX_DATA_INIT(CQueryHelpDlg)
    //}}AFX_DATA_INIT
    m_cstrHelpString.LoadString(IDS_QUERYHELPSTRING);
}

void CQueryHelpDlg::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CQueryHelpDlg)
    DDX_Text(pDX, IDC_HELPEDIT, m_cstrHelpString);
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CQueryHelpDlg, CDialog)
    //{{AFX_MSG_MAP(CQueryHelpDlg)
        // NOTE: the ClassWizard will add message map macros here
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CQueryHelpDlg message handlers


Examples - C++ LineType - QueryHelpDlg.h

QueryHelpDlg.h

C++ LineType Example

#if !defined(AFX_QUERYHELPDLG_H__AC0EA554_AE8F_11D1_B7C4_000021452DB6__INCLUDED_)
#define AFX_QUERYHELPDLG_H__AC0EA554_AE8F_11D1_B7C4_000021452DB6__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000
// QueryHelpDlg.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CQueryHelpDlg dialog

class CQueryHelpDlg : public CDialog
{
// Construction
public:
    CQueryHelpDlg(CWnd* pParent = NULL);   // standard constructor

// Dialog Data
    //{{AFX_DATA(CQueryHelpDlg)
    enum { IDD = IDD_QUERYHELP };
    CString	m_cstrHelpString;
    //}}AFX_DATA

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CQueryHelpDlg)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:

    // Generated message map functions
    //{{AFX_MSG(CQueryHelpDlg)
        // NOTE: the ClassWizard will add member functions here
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_QUERYHELPDLG_H__AC0EA554_AE8F_11D1_B7C4_000021452DB6__INCLUDED_)


Examples - C++ LineType - SelOptPage.cpp

SelOptPage.cpp

C++ LineType Example

// SelOptPage.cpp : implementation file
//

#include "stdafx.h"
#include "ltsample.h"
#include "SelOptPage.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CSelOptPage property page

IMPLEMENT_DYNCREATE(CSelOptPage, CPropertyPage)

CSelOptPage::CSelOptPage() : CPropertyPage(CSelOptPage::IDD)
{
    m_iVersion = 4;
    //{{AFX_DATA_INIT(CSelOptPage)
    m_bArcs = FALSE;
    m_bTexts = FALSE;
    m_bInvisible = FALSE;
    m_bTopLevel = FALSE;
    m_bSegments = FALSE;
    m_bBlocks = FALSE;
    //}}AFX_DATA_INIT
}

CSelOptPage::~CSelOptPage()
{
}

void CSelOptPage::DoDataExchange(CDataExchange* pDX)
{
    CPropertyPage::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CSelOptPage)
    DDX_Check(pDX, IDC_ARCS, m_bArcs);
    DDX_Check(pDX, IDC_TEXTS, m_bTexts);
    DDX_Check(pDX, IDC_INVISIBLE, m_bInvisible);
    DDX_Check(pDX, IDC_TOPLEVEL, m_bTopLevel);
    DDX_Check(pDX, IDC_INSERTS, m_bBlocks);
    DDX_Check(pDX, IDC_GRAPHICS, m_bSegments);
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CSelOptPage, CPropertyPage)
    //{{AFX_MSG_MAP(CSelOptPage)
    ON_BN_CLICKED(IDC_GRAPHICS, OnGraphics)
    ON_BN_CLICKED(IDC_INSERTS, OnInserts)
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CSelOptPage message handlers

void CSelOptPage::OnGraphics()
{
    if (m_iVersion == 4)
    {
        CButton *pGraphicsBt = (CButton *)GetDlgItem(IDC_GRAPHICS);
        CButton *pInsertsBt = (CButton *)GetDlgItem(IDC_INSERTS);

        if (pGraphicsBt->GetCheck() == 0)
            pInsertsBt->SetCheck(0);
    }
}

void CSelOptPage::OnInserts()
{
    if (m_iVersion == 4)
    {
        CButton *pGraphicsBt = (CButton *)GetDlgItem(IDC_GRAPHICS);
        CButton *pInsertsBt = (CButton *)GetDlgItem(IDC_INSERTS);

        if (pInsertsBt->GetCheck() == 1)
            pGraphicsBt->SetCheck(1);
    }
}

BOOL CSelOptPage::OnInitDialog()
{
    CPropertyPage::OnInitDialog();

    if (m_iVersion == 0)
    {
        CButton *pBt = (CButton *)GetDlgItem(IDC_GRAPHICS);
        pBt->EnableWindow(FALSE);
        pBt = (CButton *)GetDlgItem(IDC_INSERTS);
        pBt->EnableWindow(FALSE);
    }

    return TRUE;  // return TRUE unless you set the focus to a control
                  // EXCEPTION: OCX Property Pages should return FALSE
}


Examples - C++ LineType - SelOptPage.h

SelOptPage.h

C++ LineType Example

#if !defined(AFX_SELOPTPAGE_H__E7808AF4_A75C_11D1_B7B8_000021452DB6__INCLUDED_)
#define AFX_SELOPTPAGE_H__E7808AF4_A75C_11D1_B7B8_000021452DB6__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000
// SelOptPage.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CSelOptPage dialog

class CSelOptPage : public CPropertyPage
{
    DECLARE_DYNCREATE(CSelOptPage)

// Construction
public:
    CSelOptPage();
    ~CSelOptPage();

    int		m_iVersion;
// Dialog Data
    //{{AFX_DATA(CSelOptPage)
    enum { IDD = IDD_SELECT_PROPPAGE };
    BOOL	m_bArcs;
    BOOL	m_bTexts;
    BOOL	m_bInvisible;
    BOOL	m_bTopLevel;
    BOOL	m_bSegments;
    BOOL	m_bBlocks;
    //}}AFX_DATA

// Overrides
    // ClassWizard generate virtual function overrides
    //{{AFX_VIRTUAL(CSelOptPage)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:
    // Generated message map functions
    //{{AFX_MSG(CSelOptPage)
    afx_msg void OnGraphics();
    afx_msg void OnInserts();
    virtual BOOL OnInitDialog();
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()

};

//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_SELOPTPAGE_H__E7808AF4_A75C_11D1_B7B8_000021452DB6__INCLUDED_)


Examples - C++ LineType - SmartObjectInserDlg.cpp

SmartObjectInserDlg.cpp

C++ LineType Example

// SmartObjectInserDlg.cpp : implementation file
//

#include "stdafx.h"
#include "ltsample.h"
#include "SmartObjectInserDlg.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CSmartObjectInserDlg dialog

#define W_COLUMN	20

#define IND_SUBITEMINDEX		0
#define IND_SUBITEMID			1
#define IND_SUBITEMTYPE			2
#define IND_SUBITEMNAME			3
#define IND_SUBITEMDESC			4

#define IND_COLUMNINDEX			0
#define IND_COLUMNID			1
#define IND_COLUMNTYPE			2
#define IND_COLUMNAME			3
#define IND_COLUMNDESC			4

CSmartObjectInserDlg::CSmartObjectInserDlg(RegenMethods *pRegens, CWnd* pParent /*=NULL*/)
    : CDialog(CSmartObjectInserDlg::IDD, pParent)
{
    m_pRegens = pRegens;
    m_dwID = 0;
    m_rmType = imsiVTbl;
    //{{AFX_DATA_INIT(CSmartObjectInserDlg)
        // NOTE: the ClassWizard will add member initialization here
    //}}AFX_DATA_INIT
}

void CSmartObjectInserDlg::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CSmartObjectInserDlg)
    DDX_Control(pDX, IDC_LIST_SMARTOBJECT, m_lstRegens);
    //}}AFX_DATA_MAP
    if (pDX->m_bSaveAndValidate)
    {
        int iSelItem = m_lstRegens.GetNextItem(-1, LVNI_SELECTED);
        if (iSelItem >= 0)
        {
            m_dwID = m_lstRegens.GetItemData(iSelItem);
            m_cstrName = m_lstRegens.GetItemText(iSelItem, IND_SUBITEMNAME);
            m_cstrDesc = m_lstRegens.GetItemText(iSelItem, IND_SUBITEMDESC);
            CString cstrType = m_lstRegens.GetItemText(iSelItem, IND_SUBITEMTYPE);
            if (cstrType == "imsiAutomation")
                m_rmType = imsiAutomation;
            else if (cstrType == "imsiVTbl")
                m_rmType = imsiVTbl;
            else if (cstrType == "imsiScript")
                m_rmType = imsiScript;
        }
    }
}

BEGIN_MESSAGE_MAP(CSmartObjectInserDlg, CDialog)
    //{{AFX_MSG_MAP(CSmartObjectInserDlg)
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CSmartObjectInserDlg message handlers

BOOL CSmartObjectInserDlg::OnInitDialog()
{
    CDialog::OnInitDialog();

    LV_COLUMN lvcolumn;
    lvcolumn.mask = LVCF_FMT | LVCF_SUBITEM | LVCF_TEXT | LVCF_WIDTH;
    lvcolumn.fmt = LVCFMT_LEFT;

    CString sResString;
    sResString.LoadString(IDS_REGEN_INDEX);
    lvcolumn.pszText = (LPTSTR)(LPCTSTR)sResString;
    lvcolumn.iSubItem = IND_SUBITEMINDEX;
    lvcolumn.cx = W_COLUMN * 4;
    m_lstRegens.InsertColumn(IND_COLUMNINDEX, &lvcolumn);  // assumes return value is OK.

    sResString.LoadString(IDS_REGEN_ID);
    lvcolumn.pszText = (LPTSTR)(LPCTSTR)sResString;
    lvcolumn.iSubItem = IND_SUBITEMID;
    lvcolumn.cx = W_COLUMN * 4;
    m_lstRegens.InsertColumn(IND_COLUMNID, &lvcolumn);  // assumes return value is OK.

    sResString.LoadString(IDS_REGEN_TYPE);
    lvcolumn.pszText = (LPTSTR)(LPCTSTR)sResString;
    lvcolumn.iSubItem = IND_SUBITEMTYPE;
    lvcolumn.cx = W_COLUMN * 4;
    m_lstRegens.InsertColumn(IND_COLUMNTYPE, &lvcolumn);  // assumes return value is OK.

    sResString.LoadString(IDS_REGEN_NAME);
    lvcolumn.pszText = (LPTSTR)(LPCTSTR)sResString;
    lvcolumn.cx = W_COLUMN * 4;
    lvcolumn.iSubItem = IND_SUBITEMNAME;
    m_lstRegens.InsertColumn(IND_COLUMNAME, &lvcolumn);  // assumes return value is OK.

    sResString.LoadString(IDS_REGEN_DESCRIPTION);
    lvcolumn.pszText = (LPTSTR)(LPCTSTR)sResString;
    lvcolumn.cx = W_COLUMN * 5;
    lvcolumn.iSubItem = IND_SUBITEMDESC;
    m_lstRegens.InsertColumn(IND_COLUMNDESC, &lvcolumn);  // assumes return value is OK.

    long lCount = 0;
    HRESULT hRes = m_pRegens->get_Count(&lCount);
    if (SUCCEEDED(hRes))
    {
        RegenMethod *pRegen = NULL;
        CString cstrText;
        BSTR bstrVal = NULL;
        long lVal = 0;
        long lID = 0;
        ImsiRegenMethodType rmtVal = imsiVTbl;
        BOOL bVal = FALSE;
        SHORT iVal = 0;

        VARIANT varIndex;
        ::VariantInit(&varIndex);
        varIndex.vt = VT_I4;

        LV_ITEM			lvitem;
        int				index = 0;

        for (long iItem = 0; iItem < lCount; iItem++)
        {
            varIndex.lVal = iItem;
            hRes = m_pRegens->get_Item(&varIndex, &pRegen);
            if (SUCCEEDED(hRes))
            {
                ASSERT(pRegen != NULL);

                lvitem.mask = LVIF_TEXT;
                lvitem.iItem = index;

                lvitem.iSubItem = IND_SUBITEMINDEX;
                hRes = pRegen->get_Index(&lVal);
                if (SUCCEEDED(hRes))
                    cstrText.Format("%d", lVal);
                else
                    cstrText = "?";
                lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;
                index = m_lstRegens.InsertItem(&lvitem);
                ASSERT(index >= 0);

                lvitem.iSubItem = IND_SUBITEMID;
                hRes = pRegen->get__TableEntryID(&lVal);
                cstrText.Format("%d", lVal);
                lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;
                VERIFY(m_lstRegens.SetItem(&lvitem));
                m_lstRegens.SetItemData(index, lVal);

                lvitem.iSubItem = IND_SUBITEMTYPE;
                hRes = pRegen->get_Type(&rmtVal);
                switch (rmtVal)
                {
                    case imsiVTbl:
                        cstrText.Format("imsiVTbl");
                    break;
                    case imsiAutomation:
                        cstrText.Format("imsiAutomation");
                    break;
                    case imsiScript:
                        cstrText.Format("imsiScript");
                    break;
                }
                lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;
                VERIFY(m_lstRegens.SetItem(&lvitem));

                hRes = pRegen->get_Name(&bstrVal);
                ASSERT(SUCCEEDED(hRes));
                lvitem.iSubItem = IND_SUBITEMNAME;
                cstrText = bstrVal;
                ::SysFreeString(bstrVal);
                lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;
                VERIFY(m_lstRegens.SetItem(&lvitem));

                bstrVal = NULL;
                hRes = pRegen->get_Description(&bstrVal);
                ASSERT(SUCCEEDED(hRes));
                lvitem.iSubItem = IND_SUBITEMDESC;
                cstrText = bstrVal;
                ::SysFreeString(bstrVal);
                lvitem.pszText = (LPTSTR)(LPCTSTR)cstrText;
                VERIFY(m_lstRegens.SetItem(&lvitem));

                index++;

                pRegen->Release();
            }
        }
    }

    return TRUE;  // return TRUE unless you set the focus to a control
                  // EXCEPTION: OCX Property Pages should return FALSE
}


Examples - C++ LineType - SmartObjectInserDlg.h

SmartObjectInserDlg.h

C++ LineType Example

#if !defined(AFX_SMARTOBJECTINSERDLG_H__AFD14C46_BE29_11D1_B7DE_000021452DB6__INCLUDED_)
#define AFX_SMARTOBJECTINSERDLG_H__AFD14C46_BE29_11D1_B7DE_000021452DB6__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000
// SmartObjectInserDlg.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CSmartObjectInserDlg dialog

class CSmartObjectInserDlg : public CDialog
{
// Construction
public:
    CSmartObjectInserDlg(RegenMethods *pRegens, CWnd* pParent = NULL);   // standard constructor
    DWORD m_dwID;
    CString m_cstrName;
    CString m_cstrDesc;
    ImsiRegenMethodType m_rmType;

// Dialog Data
    //{{AFX_DATA(CSmartObjectInserDlg)
    enum { IDD = IDD_INSERT_SMARTOBJECT };
    CListCtrl	m_lstRegens;
    //}}AFX_DATA

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CSmartObjectInserDlg)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:

    RegenMethods*	m_pRegens;

    // Generated message map functions
    //{{AFX_MSG(CSmartObjectInserDlg)
    virtual BOOL OnInitDialog();
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_SMARTOBJECTINSERDLG_H__AFD14C46_BE29_11D1_B7DE_000021452DB6__INCLUDED_)


Examples - C++ LineType - VPWnd.cpp

VPWnd.cpp

C++ LineType Example

// VPWnd.cpp : implementation file
// TurboCAD SDK: new class implementation

#include "stdafx.h"
#include "LTSample.h"
#include "VPWnd.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CViewWnd
// TurboCAD SDK: class created to manage view on dialog box

CViewWnd::CViewWnd() :
    m_pView(NULL),
    m_bStartSelect(FALSE),
    m_pIDrawing(NULL)
{
    m_varTopLevel.vt = VT_BOOL;
    m_varInvisible.vt = VT_BOOL;
    m_varSegments.vt = VT_BOOL;
    m_varArcs.vt = VT_BOOL;
    m_varTexts.vt = VT_BOOL;
    m_varBlocks.vt = VT_BOOL;

    m_varTopLevel.boolVal = FALSE;
    m_varInvisible.boolVal = FALSE;
    m_varSegments.boolVal = TRUE;
    m_varArcs.boolVal = TRUE;
    m_varTexts.boolVal = TRUE;
    m_varBlocks.boolVal = TRUE;
}

CViewWnd::~CViewWnd()
{
    SetView(NULL);
}

BEGIN_MESSAGE_MAP(CViewWnd, CWnd)
    //{{AFX_MSG_MAP(CViewWnd)
    ON_WM_PAINT()
    ON_WM_LBUTTONDOWN()
    ON_WM_ERASEBKGND()
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

// TurboCAD SDK: set the view, if one already exists, delete and release it
//               before assigning the new one.
void CViewWnd::SetView(View* pView)
{
    if (m_pView != NULL)
    {
        // Delete view object
        m_pView->Delete();

        // Decrement reference count
        m_pView->Release();
        m_pView = NULL;
        if (m_pIDrawing != NULL)
        {
            m_pIDrawing->Release();
            m_pIDrawing = NULL;
        }
    }

    if (pView == NULL)
        return;

    m_pView = pView;

    // Increment reference count
    m_pView->AddRef();

    m_pView->put_Update(FALSE);
    // Map window to view
    m_pView->put_HWND((long)m_hWnd);

    // Keep a reference to the drawing
    m_pView->get_Drawing(&m_pIDrawing);

    // zoom to drawing extents and invalidate the window
    ZoomAndInvalidate();
}

BOOL CViewWnd::SetSelectMode()
{
    m_bStartSelect = ~m_bStartSelect;
    return m_bStartSelect;
}

IDrawing* CViewWnd::GetDrawing()
{
    if (m_pIDrawing != NULL)
        m_pIDrawing->AddRef();
    return m_pIDrawing;
}

Graphics* CViewWnd::GetGraphics()
{
    Graphics* pGraphics = NULL;
    if (m_pIDrawing != NULL)
        m_pIDrawing->get_Graphics(&pGraphics);
    return pGraphics;
}

// TurboCAD SDK: zoom to drawing extents and invalidate the window
void CViewWnd::ZoomAndInvalidate()
{
    // No view, exit
    if (m_pView == NULL)
        return;

    // Zoom to extents
    HRESULT hRes = m_pView->ZoomToExtents();
    if (FAILED(hRes))
    {
//		m_pView->put_Update(TRUE);
    }

    // Invalidate window to force redraw
    Invalidate();
}

/////////////////////////////////////////////////////////////////////////////
// CViewWnd message handlers

// TurboCAD SDK: override OnPaint to refresh the view
void CViewWnd::OnPaint()
{
    CPaintDC dc(this); // device context for painting

    if (m_pView == NULL)
        return;

    // Force redraw of view window
    HRESULT hRes = m_pView->Refresh();
    if (FAILED(hRes))
    {
    }
}

// TurboCAD SDK: override OnEraseBkgnd to reset the drawing area
BOOL CViewWnd::OnEraseBkgnd(CDC* pDC)
{
    CRect rect;
    GetClientRect(rect);
    pDC->FillSolidRect(rect, ::GetSysColor(COLOR_WINDOW));
    return TRUE;
}

void CViewWnd::OnLButtonDown(UINT nFlags, CPoint point)
{
    if (m_bStartSelect)
    {
        Selection *pSel = NULL;
        HRESULT hRes = m_pIDrawing->get_Selection(&pSel);
        if (SUCCEEDED(hRes))
        {
            pSel->Unselect();
            pSel->Release();
        }

        double dblX, dblY;
        m_pView->ScreenToView(point.x,point.y, &dblX,&dblY);

        COleVariant varAperture((const double&)0.1);
        PickResult *pPickRes = NULL;

        hRes = m_pView->PickPoint(dblX, dblY,
                                   &varAperture,
                                   &m_varTopLevel,
                                   &m_varArcs,
                                   &m_varTexts,
                                   &m_varSegments,
                                   &m_varBlocks,
                                   &m_varInvisible,
                                   &pPickRes);
        if (SUCCEEDED(hRes))
        {
            PickEntry *pPickEntry = NULL;
            COleVariant varIndex((long)0);
            hRes = pPickRes->get_Item(&varIndex,&pPickEntry);
            if (SUCCEEDED(hRes))
            {
                IGraphic *pIGr = NULL;
                hRes = pPickEntry->get_Graphic(&pIGr);
                if (SUCCEEDED(hRes))
                {
                    hRes = pIGr->Select();
                    if (SUCCEEDED(hRes))
                    {
                        AfxMessageBox(IDS_SYMBOLSELECTED);
                    }
                    else
                        AfxMessageBox(IDS_CANNOTSELECTGRAPHIC);
                    pIGr->Release();
                }
                pPickEntry->Release();
            }
            else
                AfxMessageBox(IDS_CANNOTGETPICKENTRY);
            pPickRes->Release();
        }
        GetParent()->SendMessage(WM_COMMAND, MAKEWPARAM(IDC_SELECTSYMBOL, BN_CLICKED), 0);
    }
    CWnd::OnLButtonDown(nFlags, point);
}


Examples - C++ LineType - VPWnd.h

VPWnd.h

C++ LineType Example

// VPWnd.h : header file
// TurboCAD SDK: New class created to handle the drawing view on the dialog box.

/////////////////////////////////////////////////////////////////////////////
// CViewWnd window

class CViewWnd : public CWnd
{
// Construction
public:
    CViewWnd();

// Attributes
protected:
    View	*m_pView;
    IDrawing* m_pIDrawing;
    BOOL	m_bStartSelect;

// Operations
public:
    // Set up the current view
    void SetView(View* pView);
    // Zoom to the extents of the drawing and refresh the window
    void ZoomAndInvalidate();
    BOOL SetSelectMode();
    IDrawing* GetDrawing();
    Graphics* GetGraphics();

    COleVariant	m_varTopLevel;
    COleVariant	m_varInvisible;
    COleVariant	m_varSegments;
    COleVariant	m_varArcs;
    COleVariant	m_varTexts;
    COleVariant	m_varBlocks;

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CViewWnd)
    //}}AFX_VIRTUAL

// Implementation
public:
    virtual ~CViewWnd();

    // Generated message map functions
protected:
    //{{AFX_MSG(CViewWnd)
    afx_msg void OnPaint();
    afx_msg BOOL OnEraseBkgnd(CDC* pDC);
    afx_msg void OnLButtonDown(UINT nFlags, CPoint point);
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

/////////////////////////////////////////////////////////////////////////////


Examples - C++ MakeDwg - MakeDwg.cpp

MakeDwg.cpp

C++ MakeDwg Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// MakeDwg.cpp : Defines the class behaviors for the application.
//

#include "stdafx.h"
#include "MakeDwg.h"
#include "MDDialog.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CMakeDwgApp

BEGIN_MESSAGE_MAP(CMakeDwgApp, CWinApp)
    //{{AFX_MSG_MAP(CMakeDwgApp)
        // NOTE - the ClassWizard will add and remove mapping macros here.
        //    DO NOT EDIT what you see in these blocks of generated code!
    //}}AFX_MSG
    ON_COMMAND(ID_HELP, CWinApp::OnHelp)
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CMakeDwgApp construction

CMakeDwgApp::CMakeDwgApp()
{
    // TODO: add construction code here,
    // Place all significant initialization in InitInstance
}

/////////////////////////////////////////////////////////////////////////////
// The one and only CMakeDwgApp object

CMakeDwgApp theApp;

/////////////////////////////////////////////////////////////////////////////
// CMakeDwgApp initialization

BOOL CMakeDwgApp::InitInstance()
{
    // Initialize OLE libraries
    if (!AfxOleInit())
    {
        AfxMessageBox(IDP_OLE_INIT_FAILED);
        return FALSE;
    }

    // Standard initialization
    // If you are not using these features and wish to reduce the size
    //  of your final executable, you should remove from the following
    //  the specific initialization routines you do not need.

#ifdef _AFXDLL
    Enable3dControls();			// Call this when using MFC in a shared DLL
#else
    Enable3dControlsStatic();	// Call this when linking to MFC statically
#endif

    // Parse the command line to see if launched as OLE server
    if (RunEmbedded() || RunAutomated())
    {
        // Register all OLE server (factories) as running.  This enables the
        //  OLE libraries to create objects from other applications.
        COleTemplateServer::RegisterAll();

        // Application was run with /Embedding or /Automation.  Don't show the
        //  main window in this case.
        return TRUE;
    }

    // When a server application is launched stand-alone, it is a good idea
    //  to update the system registry in case it has been damaged.
    COleObjectFactory::UpdateRegistryAll();

    CMakeDwgDlg dlg;
    m_pMainWnd = &dlg;
    int nResponse = dlg.DoModal();
    if (nResponse == IDOK)
    {
        // TODO: Place code here to handle when the dialog is
        //  dismissed with OK
    }
    else if (nResponse == IDCANCEL)
    {
        // TODO: Place code here to handle when the dialog is
        //  dismissed with Cancel
    }

    // Since the dialog has been closed, return FALSE so that we exit the
    //  application, rather than start the application's message pump.
    return FALSE;
}


Examples - C++ MakeDwg - MakeDwg.h

MakeDwg.h

C++ MakeDwg Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/

// MakeDwg.h : main header file for the MAKEDWG application
//

#ifndef __AFXWIN_H__
    #error include 'stdafx.h' before including this file for PCH
#endif

#include "resource.h"		// main symbols

/////////////////////////////////////////////////////////////////////////////
// CMakeDwgApp:
// See MakeDwg.cpp for the implementation of this class
//

class CMakeDwgApp : public CWinApp
{
public:
    CMakeDwgApp();

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CMakeDwgApp)
    public:
    virtual BOOL InitInstance();
    //}}AFX_VIRTUAL

// Implementation

    //{{AFX_MSG(CMakeDwgApp)
        // NOTE - the ClassWizard will add and remove member functions here.
        //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

/////////////////////////////////////////////////////////////////////////////


Examples - C++ MakeDwg - MDDialog.cpp

MDDialog.cpp

C++ MakeDwg Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// MDDialog.cpp : implementation file
//

#include "stdafx.h"
#include "MakeDwg.h"
#include "MDDialog.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CAboutDlg dialog used for App About

class CAboutDlg : public CDialog
{
public:
    CAboutDlg();

// Dialog Data
    //{{AFX_DATA(CAboutDlg)
    enum { IDD = IDD_ABOUTBOX };
    //}}AFX_DATA

    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CAboutDlg)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:
    //{{AFX_MSG(CAboutDlg)
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

CAboutDlg::CAboutDlg() : CDialog(CAboutDlg::IDD)
{
    //{{AFX_DATA_INIT(CAboutDlg)
    //}}AFX_DATA_INIT
}

void CAboutDlg::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CAboutDlg)
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CAboutDlg, CDialog)
    //{{AFX_MSG_MAP(CAboutDlg)
        // No message handlers
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CMakeDwgDlg dialog

CMakeDwgDlg::CMakeDwgDlg(CWnd* pParent /*=NULL*/)
    : CDialog(CMakeDwgDlg::IDD, pParent),
    m_pIApplication(NULL) // TurboCAD SDK: initialize
{
    //{{AFX_DATA_INIT(CMakeDwgDlg)
        // NOTE: the ClassWizard will add member initialization here
    //}}AFX_DATA_INIT
    // Note that LoadIcon does not require a subsequent DestroyIcon in Win32
    m_hIcon = AfxGetApp()->LoadIcon(IDR_MAINFRAME);
}

// TurboCAD SDK: make sure we release the application
CMakeDwgDlg::~CMakeDwgDlg()
{
    m_view.SetView(NULL);

    // Finished with application, decrement the reference count
    if (m_pIApplication != NULL)
        m_pIApplication->Release();
}

void CMakeDwgDlg::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CMakeDwgDlg)
        // NOTE: the ClassWizard will add DDX and DDV calls here
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CMakeDwgDlg, CDialog)
    //{{AFX_MSG_MAP(CMakeDwgDlg)
    ON_WM_SYSCOMMAND()
    ON_WM_PAINT()
    ON_WM_QUERYDRAGICON()
    ON_BN_CLICKED(IDC_ADDCIRCLE, OnAddCircle)
    ON_BN_CLICKED(IDC_ADDLINE, OnAddLine)
    ON_BN_CLICKED(IDC_ADDSPLINE, OnAddSpline)
    ON_BN_CLICKED(IDC_NEWDRAWING, OnNewDrawing)
    ON_BN_CLICKED(IDC_INPROC_SERVER, OnInprocServer)
    ON_BN_CLICKED(IDC_LOCAL_SERVER, OnLocalServer)
    ON_BN_CLICKED(IDC_OPENDRAWING, OnOpenDrawing)
    ON_BN_CLICKED(IDC_SAVEDRAWING, OnSaveDrawing)
    ON_BN_CLICKED(IDC_GETACTIVE, OnGetActive)
    ON_LBN_SELCHANGE(IDC_LISTDRAWINGS, OnSelchangeDrawings)
    ON_BN_CLICKED(IDC_ADDBEZIER, OnAddBezier)
    ON_WM_DESTROY()
    ON_BN_CLICKED(IDC_CURVESMOOTH, OnCurveSmooth)
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CMakeDwgDlg message handlers

// TurboCAD SDK: TurboCAD Class Identifier and Interface Identifier
const CLSID CLSID_Application  = {0x6A481001,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const CLSID CLSID_XApplication = {0x6A481801,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_IApplication = {0x6A481101,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

BOOL CMakeDwgDlg::OnInitDialog()
{
    CDialog::OnInitDialog();

    // TurboCAD SDK: associate the view with static on dialog box
    m_view.SubclassDlgItem(IDC_PREVIEWRECT, this);

    // Add "About..." menu item to system menu.

    // IDM_ABOUTBOX must be in the system command range.
    ASSERT((IDM_ABOUTBOX & 0xFFF0) == IDM_ABOUTBOX);
    ASSERT(IDM_ABOUTBOX < 0xF000);

    CMenu* pSysMenu = GetSystemMenu(FALSE);
    CString strAboutMenu;
    strAboutMenu.LoadString(IDS_ABOUTBOX);
    if (!strAboutMenu.IsEmpty())
    {
        pSysMenu->AppendMenu(MF_SEPARATOR);
        pSysMenu->AppendMenu(MF_STRING, IDM_ABOUTBOX, strAboutMenu);
    }

    // Set the icon for this dialog.  The framework does this automatically
    //  when the application's main window is not a dialog
    SetIcon(m_hIcon, TRUE);			// Set big icon
    SetIcon(m_hIcon, FALSE);		// Set small icon

    // TODO: Add extra initialization here

    return TRUE;  // return TRUE  unless you set the focus to a control
}

void CMakeDwgDlg::OnSysCommand(UINT nID, LPARAM lParam)
{
    if ((nID & 0xFFF0) == IDM_ABOUTBOX)
    {
        CAboutDlg dlgAbout;
        dlgAbout.DoModal();
    }
    else
    {
        CDialog::OnSysCommand(nID, lParam);
    }
}

// If you add a minimize button to your dialog, you will need the code below
//  to draw the icon.  For MFC applications using the document/view model,
//  this is automatically done for you by the framework.

void CMakeDwgDlg::OnPaint()
{
    if (IsIconic())
    {
        CPaintDC dc(this); // device context for painting

        SendMessage(WM_ICONERASEBKGND, (WPARAM) dc.GetSafeHdc(), 0);

        // Center icon in client rectangle
        int cxIcon = GetSystemMetrics(SM_CXICON);
        int cyIcon = GetSystemMetrics(SM_CYICON);
        CRect rect;
        GetClientRect(&rect);
        int x = (rect.Width() - cxIcon + 1) / 2;
        int y = (rect.Height() - cyIcon + 1) / 2;

        // Draw the icon
        dc.DrawIcon(x, y, m_hIcon);
    }
    else
    {
        CDialog::OnPaint();
    }
}

// The system calls this to obtain the cursor to display while the user drags
//  the minimized window.
HCURSOR CMakeDwgDlg::OnQueryDragIcon()
{
    return (HCURSOR) m_hIcon;
}

const IID IID_Properties = {0x6A48110F,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

// TurboCAD SDK: function to add a circle to the active drawing
void CMakeDwgDlg::OnAddCircle()
{
    // Pointer to Graphics collection
    Graphics* pGraphics = m_view.GetGraphics();
    if (pGraphics == NULL)
    {
        AfxMessageBox("Create new drawing first!");
        return;
    }

    // Pointer to graphic object
    IGraphic* pIGraphic = NULL;
    IGraphic* pTGraphic = NULL;
    double xc = 10.0;
    double yc = 10.0;
    double zc = 0.0;
    double xp = 15.0;
    double yp = 10.0;
    double zp = 0.0;

    // Add graphic to drawing
    HRESULT hRes = pGraphics->AddCircleCenterAndPoint(xc, yc, zc, xp, yp, zp, &pIGraphic);
    if (SUCCEEDED(hRes))
    {
        // Change pen color of circle
        Properties* pProp = NULL;
        Property* pPenColor = NULL;

#if 1
        // Code to find out where the local server bug is...
        IDispatch* pDisp = NULL;
        hRes = pIGraphic->QueryInterface(IID_IDispatch, (void**)&pDisp);
        if (SUCCEEDED(hRes))
        {
            LPOLESTR oszProperties = OLESTR("Properties");
            DISPID dispid;
            hRes = pDisp->GetIDsOfNames(
                IID_NULL,
                &oszProperties,
                1,
                0,
                &dispid);
            if (SUCCEEDED(hRes))
            {
                VARIANTARG args[1];
                VariantInit(&args[0]);
                DISPPARAMS params = { args, NULL, 0, 0 };
                hRes = pDisp->Invoke(dispid,
                    IID_NULL,
                    0,
                    DISPATCH_PROPERTYGET,
                    &params,
                    &args[0],
                    NULL,
                    NULL);

                if (SUCCEEDED(hRes) && args[0].vt == VT_DISPATCH)
                {
                    // JON: DISP_E_BADVARTYPE returned here!
                    // CGrfPropertiesObject::InternalQueryInterface on the server side IS returning S_OK.
                    // But somewhere the OLE marshaller doesn't like it...
                    hRes = args[0].pdispVal->QueryInterface(IID_Properties, (void**)&pProp);
                }
                VariantClear(&args[0]);
            }

            pDisp->Release();
        }
#else
        hRes = pIGraphic->get_Properties(&pProp);
#endif
        if (SUCCEEDED(hRes))
        {
            // Change pen color
            COleVariant var("PenColor");
            hRes = pProp->get_Item(&var, &pPenColor);
            if (SUCCEEDED(hRes))
            {
                var = (long)0x0000FF;
                hRes = pPenColor->put_Value(0, &var);

                pPenColor->Release();
            }
            pProp->Release();
        }
        CString str("Circle");
        BSTR var = str.AllocSysString();
        hRes = pGraphics->AddText(str.AllocSysString(),10.0, 10.0, 0.0, .5,
                            COleVariant(3.1415/2.0),
                            COleVariant(DISP_E_PARAMNOTFOUND, VT_ERROR),
                            COleVariant(DISP_E_PARAMNOTFOUND, VT_ERROR),
                            COleVariant(DISP_E_PARAMNOTFOUND, VT_ERROR),
                            &pTGraphic);
        // Finished with graphic, decrement the reference count
        if (SUCCEEDED(hRes))
            pTGraphic->Release();
        pIGraphic->Release();
    }

    // Finished with Graphics collection, decrement the reference count
    pGraphics->Release();

    // Zoom view to extents and invalidate window
    m_view.ZoomAndInvalidate();
}

// TurboCAD SDK: function to add a line to the active drawing
void CMakeDwgDlg::OnAddLine()
{
    // Pointer to Graphics collection
    Graphics* pGraphics = m_view.GetGraphics();
    if (pGraphics == NULL)
    {
        AfxMessageBox("Create new drawing first!");
        return;
    }

    // Pointer to graphic object
    IGraphic* pIGraphic = NULL;
    double x0 = 5.0;
    double y0 = 10.0;
    double z0 = 0.0;
    double x1 = 15.0;
    double y1 = 10.0;
    double z1 = 0.0;

    // Add graphic to drawing
    HRESULT hRes = pGraphics->AddLineSingle(x0, y0, z0, x1, y1, z1, &pIGraphic);

    if (SUCCEEDED(hRes))
    {
        // Finished with graphic, decrement reference count
        pIGraphic->Release();
    }

    // Finished with the Graphics collection, decrement reference count
    pGraphics->Release();

    // Zoom view to extents and invalidate window
    m_view.ZoomAndInvalidate();
}

// TurboCAD SDK: function to add a spline to the active drawing
void CMakeDwgDlg::OnAddSpline()
{
    const int NSPLPOINTS = 5;
    static double x[NSPLPOINTS] = { 1.0, 2.0, 5.0, 7.0, 9.0 };
    static double y[NSPLPOINTS] = { 4.0, 6.0, 4.0, 2.0, 5.0 };
    static double z[NSPLPOINTS] = { 0.0, 0.0, 0.0,  0.0, 0.0 };

    // Pointer to Graphics collection
    Graphics* pGraphics = m_view.GetGraphics();
    if (pGraphics == NULL)
    {
        AfxMessageBox("Create new drawing first!");
        return;
    }

    // Pointer to graphic object
    IGraphic* pIGraphic = NULL;

    // Add graphic to drawing with starting vertex x[0], y[0], z[0]
    HRESULT hRes = pGraphics->AddCurveSpline(x[0], y[0], z[0], &pIGraphic);
    if (SUCCEEDED(hRes))
    {
        Vertices* pVertices = NULL;
        hRes = pIGraphic->get_Vertices(&pVertices);
        if (SUCCEEDED(hRes))
        {
            // Make a "missing" optional parameter
            VARIANT var;
            var.vt = VT_ERROR;
            var.scode = DISP_E_PARAMNOTFOUND;

            // Add rest of points to spline curve
            VARIANT varX;
            varX.vt = VT_R8;
            VARIANT varY;
            varY.vt = VT_R8;
            VARIANT varZ;
            varZ.vt = VT_R8;
            int i;
            for (i = 1; i < NSPLPOINTS; ++i)
            {
                varX.dblVal = x[i];
                varY.dblVal = y[i];
                varZ.dblVal = z[i];
                IVertex* pIVertex = NULL;
                hRes = pVertices->Add(&varX, &varY, &varZ,
                    &var, &var, &var, &var, &var, &var, &var, &var, &pIVertex);
                if (pIVertex != NULL)
                    pIVertex->Release();
            }
            pVertices->Release();

            // Change pen color of spline
            Properties* pProp = NULL;
            Property* pPenColor = NULL;

            hRes = pIGraphic->get_Properties(&pProp);
            if (SUCCEEDED(hRes))
            {
                // Change pen color
                COleVariant var("PenColor");
                hRes = pProp->get_Item(&var, &pPenColor);
                if (SUCCEEDED(hRes))
                {
                    var = (long)0x00FF00;
                    hRes = pPenColor->put_Value(0, &var);

                    pPenColor->Release();
                }
                pProp->Release();
            }
        }

        // Finished with graphic, decrement the reference count
        pIGraphic->Release();
    }

    // Finished with Graphics collection, decrement reference count
    pGraphics->Release();

    // Zoom view to extents and invalidate window
    m_view.ZoomAndInvalidate();
}

// TurboCAD SDK: function to add a bezier curve to the active drawing
void CMakeDwgDlg::OnAddBezier()
{
    const int NBEZPOINTS = 7;
    static double x[NBEZPOINTS] = { 1.0, 2.0, 5.0, 7.0, 9.0, 10.0, 11.0 };
    static double y[NBEZPOINTS] = { 4.0, 6.0, 4.0, 2.0, 5.0, 4.0, 2.0 };
    static double z[NBEZPOINTS] = { 0.0, 0.0, 0.0,  0.0, 0.0, 0.0, 0.0 };

    // Pointer to Graphics collection
    Graphics* pGraphics = m_view.GetGraphics();
    if (pGraphics == NULL)
    {
        AfxMessageBox("Create new drawing first!");
        return;
    }

    // Pointer to graphic object
    IGraphic* pIGraphic = NULL;

    // Add graphic to drawing with starting vertex x[0], y[0], z[0]
    HRESULT hRes = pGraphics->AddCurveBezier(x[0], y[0], z[0], &pIGraphic);
    if (SUCCEEDED(hRes))
    {
        Vertices* pVertices = NULL;
        hRes = pIGraphic->get_Vertices(&pVertices);
        if (SUCCEEDED(hRes))
        {
            // Make a "missing" optional parameter
            VARIANT varMissing;
            varMissing.vt = VT_ERROR;
            varMissing.scode = DISP_E_PARAMNOTFOUND;

            // Add rest of points to spline curve
            VARIANT varX;
            varX.vt = VT_R8;
            VARIANT varY;
            varY.vt = VT_R8;
            VARIANT varZ;
            varZ.vt = VT_R8;
            int i;
            for (i = 1; i < NBEZPOINTS; ++i)
            {
                varX.dblVal = x[i];
                varY.dblVal = y[i];
                varZ.dblVal = z[i];

                // Make and set the "Calculated" parameter
                // On-curve points are not calculated.
                // Off-curve points are calculated.
                VARIANT varCalculated;
                varCalculated.vt = VT_BOOL;
                varCalculated.boolVal = ((i % 3) != 0) ? -1 : 0;

                IVertex* pIVertex = NULL;
                hRes = pVertices->Add(&varX, &varY, &varZ,
                    &varMissing, &varMissing, &varMissing, &varMissing, &varMissing,
                    &varCalculated, &varMissing, &varMissing, &pIVertex);
                if (pIVertex != NULL)
                    pIVertex->Release();
            }
            pVertices->Release();

            // Change pen color of spline
            Properties* pProp = NULL;
            Property* pPenColor = NULL;

            hRes = pIGraphic->get_Properties(&pProp);
            if (SUCCEEDED(hRes))
            {
                // Change pen color
                COleVariant var("PenColor");
                hRes = pProp->get_Item(&var, &pPenColor);
                if (SUCCEEDED(hRes))
                {
                    var = (long)0x00FF00;
                    hRes = pPenColor->put_Value(0, &var);

                    pPenColor->Release();
                }
                pProp->Release();
            }
        }

        // Finished with graphic, decrement the reference count
        pIGraphic->Release();
    }
    // Finished with Graphics collection, decrement reference count
    pGraphics->Release();

    // Zoom view to extents and invalidate window
    m_view.ZoomAndInvalidate();
}

HRESULT CMakeDwgDlg::SetupView(IDrawing* pIDrawing)
{
    // Pointer to View collection
    Views* pViews = NULL;

    // Get the handle to the view collection
    HRESULT hRes = pIDrawing->get_Views(&pViews);
    if (SUCCEEDED(hRes))
    {
        // Pointer to view object
        View* pView = NULL;

        // Make a "missing" optional parameter
        VARIANT var;
        var.vt = VT_ERROR;
        var.scode = DISP_E_PARAMNOTFOUND;

        // Add the view to the collection
        hRes = pViews->Add(&var, &var, &pView);

        if (SUCCEEDED(hRes))
        {
            // Set up view to be the active view
            m_view.SetView(pView);

            // Finished with view, decrement reference count
            pView->Release();
        }

        // Finished with views, decrement reference count
        pViews->Release();
    }
    return hRes;
}

void CMakeDwgDlg::EnableButtons()
{
    BOOL bEnable = (m_pIApplication != NULL);
    GetDlgItem(IDC_INPROC_SERVER)->EnableWindow(!bEnable);
    GetDlgItem(IDC_LOCAL_SERVER)->EnableWindow(!bEnable);
    GetDlgItem(IDC_NEWDRAWING)->EnableWindow(bEnable);
    GetDlgItem(IDC_OPENDRAWING)->EnableWindow(bEnable);

    if (bEnable)
    {
        bEnable = FALSE;
        Graphics* pGraphics = m_view.GetGraphics();
        if (pGraphics != NULL)
        {
            bEnable = TRUE;
            pGraphics->Release();
        }
    }
    GetDlgItem(IDC_ADDCIRCLE)->EnableWindow(bEnable);
    GetDlgItem(IDC_ADDLINE)->EnableWindow(bEnable);
    GetDlgItem(IDC_ADDSPLINE)->EnableWindow(bEnable);
    GetDlgItem(IDC_ADDBEZIER)->EnableWindow(bEnable);
    GetDlgItem(IDC_SAVEDRAWING)->EnableWindow(bEnable);
}

void CMakeDwgDlg::SyncToApplication()
{
    if (m_pIApplication == NULL)
        return;

    // Pointer to Drawings collection
    Drawings* pDrawings = NULL;

    // Get the handle to the drawings collection
    HRESULT hRes = m_pIApplication->get_Drawings(&pDrawings);
    if (SUCCEEDED(hRes))
    {
        COleVariant varIndex;
        varIndex.vt = VT_I4;
        for (varIndex.lVal = 0L; ; ++varIndex.lVal)
        {
            IDrawing* pIDrawing = NULL;
            hRes = pDrawings->get_Item(&varIndex, &pIDrawing);
            if (FAILED(hRes))
                break;
            BSTR bstrName = NULL;
            hRes = pIDrawing->get_Name(&bstrName);
            if (SUCCEEDED(hRes))
            {
                ASSERT(bstrName != NULL);
                CString strName = bstrName;
                ::SysFreeString(bstrName);
                CListBox* pList = (CListBox*)GetDlgItem(IDC_LISTDRAWINGS);
                int iString = pList->AddString(strName);
                if (varIndex.lVal == 0)
                {
                    pList->SetCurSel(iString);
                    SetupView(pIDrawing);
                }
            }

            // Finished with drawing object, decrement reference count
            pIDrawing->Release();
        }
        pDrawings->Release();
    }

}

void CMakeDwgDlg::OnInprocServer()
{
    // TurboCAD SDK: Connect to the server
    HRESULT hRes = CoCreateInstance(
        CLSID_XApplication,	//Class identifier (CLSID) of the object
        NULL,	//Object is or isn't part of an aggregate
        CLSCTX_INPROC_SERVER,	//Context for running executable code
        IID_IApplication,	//Interface identifier
        (void**)&m_pIApplication	//Points to requested interface pointer
    );

    if (FAILED(hRes))
    {
        AfxMessageBox("Couldn't create application object (in-process server)!");
    }

    EnableButtons();
}

extern "C" const IID IID_IPickRectSink = {0x6A481202,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

void CMakeDwgDlg::OnLocalServer()
{
    // TurboCAD SDK: Connect to the server
    HRESULT hRes = CoCreateInstance(
        CLSID_Application,	//Class identifier (CLSID) of the object
        NULL,	//Object is or isn't part of an aggregate
        CLSCTX_LOCAL_SERVER,	//Context for running executable code
        IID_IApplication,	//Interface identifier
        (void**)&m_pIApplication	//Points to requested interface pointer
    );

    if (FAILED(hRes))
    {
        AfxMessageBox("Couldn't create application object (local server)!");
    }

    SyncToApplication();
    EnableButtons();
}

void CMakeDwgDlg::OnGetActive()
{
    if (m_pIApplication != NULL)
        return;

    // Try to connect to running TurboCAD
    IUnknown* pUnk = NULL;
    HRESULT hRes = ::GetActiveObject(CLSID_Application, NULL, &pUnk);
    if (FAILED(hRes))
    {
        AfxMessageBox("TurboCAD is not active!");
        return;
    }
    hRes = pUnk->QueryInterface(IID_IApplication, (void**)&m_pIApplication);
    pUnk->Release();
    if (FAILED(hRes))
    {
        AfxMessageBox("Object is not a TurboCAD application!");
    }

    SyncToApplication();
    EnableButtons();
}

// TurboCAD SDK: function to an active drawing to the application
void CMakeDwgDlg::OnNewDrawing()
{
    // Pointer to Drawings collection
    Drawings* pDrawings = NULL;

    // Get the handle to the drawings collection
    HRESULT hRes = m_pIApplication->get_Drawings(&pDrawings);
    if (FAILED(hRes))
    {
        return;
    }

    // Pointer to drawing object
    IDrawing* pIDrawing = NULL;

    // Make a "missing" optional parameter
    VARIANT var;
    var.vt = VT_ERROR;
    var.scode = DISP_E_PARAMNOTFOUND;

    // Add the drawing to the drawings collection
    hRes = pDrawings->Add(&var, &pIDrawing);
    if (SUCCEEDED(hRes))
    {
        long lCount = 0;
        hRes = pDrawings->get_Count(&lCount);

        char szName[32];
        wsprintf(szName, "Drawing %ld", lCount);
        CListBox* pList = (CListBox*)GetDlgItem(IDC_LISTDRAWINGS);
        pList->SetCurSel(pList->AddString(szName));

        hRes = SetupView(pIDrawing);

        // Finished with drawing object, decrement reference count
        pIDrawing->Release();
    }

    // Finished with drawings collection, decrement reference count
    pDrawings->Release();

    EnableButtons();
}

static char BASED_CODE szFilter[] = "TurboCAD Drawing Files (*.tcw)|*.tcw|All Files (*.*)|*.*||";

void CMakeDwgDlg::OnOpenDrawing()
{
    CFileDialog dlg(TRUE, NULL, NULL, OFN_HIDEREADONLY | OFN_OVERWRITEPROMPT, szFilter, this);
    if (dlg.DoModal() != IDOK)
        return;

    // Pointer to Drawings collection
    Drawings* pDrawings = NULL;

    // Get the handle to the drawings collection
    HRESULT hRes = m_pIApplication->get_Drawings(&pDrawings);
    if (FAILED(hRes))
    {
        return;
    }

    // Pointer to drawing object
    IDrawing* pIDrawing = NULL;

    // Make a "missing" optional parameter
    VARIANT var;
    var.vt = VT_ERROR;
    var.scode = DISP_E_PARAMNOTFOUND;

    // Get the file name into a BSTR
    CString strPath = dlg.GetPathName();
    BSTR bstrPath = strPath.AllocSysString();

    // Add the drawing to the drawings collection
    hRes = pDrawings->Open(bstrPath, &var, &var, &pIDrawing);

    // Free the system memory for the BSTR
    ::SysFreeString(bstrPath);

    if (SUCCEEDED(hRes))
    {
        CListBox* pList = (CListBox*)GetDlgItem(IDC_LISTDRAWINGS);
        pList->SetCurSel(pList->AddString(strPath));

        hRes = SetupView(pIDrawing);

        // Finished with drawing object, decrement reference count
        pIDrawing->Release();
    }
    else
    {
        // File was not opened.  Maybe the filter gave us a reason.
        CString strDesc("Unknown");

        // Try to get thread-wide error object
        IErrorInfo* pErrorInfo = NULL;
        if (SUCCEEDED(::GetErrorInfo(0, &pErrorInfo)))
        {
            // Try to get description string
            BSTR bstrDesc = NULL;
            if (SUCCEEDED(pErrorInfo->GetDescription(&bstrDesc)))
            {
                strDesc = bstrDesc;
                ::SysFreeString(bstrDesc);
            }
            pErrorInfo->Release();
        }

        // Display failure message
        CString msg = "Could not open '" + strPath + "': " + strDesc;
        MessageBox(msg);
    }

    // Finished with drawings collection, decrement reference count
    pDrawings->Release();

    EnableButtons();
}

void CMakeDwgDlg::OnSaveDrawing()
{
    // Pointer to Drawing object
    IDrawing* pIDrawing = m_view.GetDrawing();
    if (pIDrawing == NULL)
    {
        AfxMessageBox("Create new drawing first!");
        return;
    }

    CFileDialog dlg(FALSE, NULL, NULL, OFN_HIDEREADONLY | OFN_OVERWRITEPROMPT, szFilter, this);
    if (dlg.DoModal() == IDOK)
    {
        // Make a "missing" optional parameter
        VARIANT var;
        var.vt = VT_ERROR;
        var.scode = DISP_E_PARAMNOTFOUND;

        // Get the file name into a BSTR
        CString strPath = dlg.GetPathName();
        BSTR bstrPath = strPath.AllocSysString();

        HRESULT hRes = pIDrawing->SaveAs(bstrPath, &var);

        // Free the system memory for the BSTR
        ::SysFreeString(bstrPath);
    }

    // Done with drawing
    pIDrawing->Release();
}

void CMakeDwgDlg::OnSelchangeDrawings()
{
    if (m_pIApplication == NULL)
        return;

    CListBox* pList = (CListBox*)GetDlgItem(IDC_LISTDRAWINGS);
    long l = pList->GetCurSel();
    if (l < 0)
        return;

    Drawings* pDrawings = NULL;
    HRESULT hRes = m_pIApplication->get_Drawings(&pDrawings);
    if (FAILED(hRes))
        return;

    COleVariant var(l);
    IDrawing* pIDrawing = NULL;
    hRes = pDrawings->get_Item(&var, &pIDrawing);
    if (SUCCEEDED(hRes))
    {
        hRes = pIDrawing->Activate();
        hRes = SetupView(pIDrawing);

        // Finished with drawing object, decrement reference count
        pIDrawing->Release();
    }

    EnableButtons();
}

void CMakeDwgDlg::OnDestroy()
{
    CDialog::OnDestroy();

    m_view.SetView(NULL);

    // Finished with application, decrement the reference count
    if (m_pIApplication != NULL)
    {
        m_pIApplication->Release();
        m_pIApplication = NULL;
    }
}

void CMakeDwgDlg::OnCurveSmooth()
{
    // Pointer to Graphics collection
    Graphics* pGraphics = m_view.GetGraphics();
    if (pGraphics == NULL)
    {
        AfxMessageBox("Create new drawing first!");
        return;
    }

    // Pointer to graphic object
    IGraphic* pIGraphic;
    COleVariant varIndex(0L);
    HRESULT hRes = pGraphics->get_Item(&varIndex, &pIGraphic);
    if (SUCCEEDED(hRes))
    {
        Properties* prop = NULL;
        Property* fprop = NULL;
        if (SUCCEEDED(pIGraphic->get_Properties(&prop)))
        {
            COleVariant vsmooth("$CurveSmooth");
            hRes = prop->get_Item(&vsmooth, &fprop);
            if (SUCCEEDED(hRes))
            {
                COleVariant varValue;
                hRes = fprop->get_Value(0, &varValue);
                if (SUCCEEDED(hRes))
                {
                    ASSERT(varValue.vt == VT_I2);
                    if (varValue.iVal)
                        varValue.iVal = 0;
                    else
                        varValue.iVal = 1;
                    fprop->put_Value(0, &varValue);
                    m_view.Invalidate();
                }
                fprop->Release();
            }
            prop->Release();
        }
        pIGraphic->Release();
    }
    pGraphics->Release();
}


Examples - C++ MakeDwg - MDDialog.h

MDDialog.h

C++ MakeDwg Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// MDDialog.h : header file
//

#include "VPWnd.h"

/////////////////////////////////////////////////////////////////////////////
// CMakeDwgDlg dialog

class CMakeDwgDlg : public CDialog
{
// Construction
public:
    CMakeDwgDlg(CWnd* pParent = NULL);	// standard constructor
    ~CMakeDwgDlg(); // TurboCAD SDK: make sure we release the application

// Dialog Data
    //{{AFX_DATA(CMakeDwgDlg)
    enum { IDD = IDD_MAKEDWG_DIALOG };
        // NOTE: the ClassWizard will add data members here
    //}}AFX_DATA

    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CMakeDwgDlg)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);	// DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:
    HRESULT SetupView(IDrawing* pIDrawing);
    void SyncToApplication();
    void EnableButtons();

    // TurboCAD SDK: add view member
    CViewWnd m_view;
    HICON m_hIcon;

    // TurboCAD SDK:  Pointer to the running application.
    IApplication* m_pIApplication;

    // Generated message map functions
    //{{AFX_MSG(CMakeDwgDlg)
    virtual BOOL OnInitDialog();
    afx_msg void OnSysCommand(UINT nID, LPARAM lParam);
    afx_msg void OnPaint();
    afx_msg HCURSOR OnQueryDragIcon();
    afx_msg void OnAddCircle();
    afx_msg void OnAddLine();
    afx_msg void OnAddSpline();
    afx_msg void OnNewDrawing();
    afx_msg void OnInprocServer();
    afx_msg void OnLocalServer();
    afx_msg void OnOpenDrawing();
    afx_msg void OnSaveDrawing();
    afx_msg void OnGetActive();
    afx_msg void OnSelchangeDrawings();
    afx_msg void OnAddBezier();
    afx_msg void OnDestroy();
    afx_msg void OnCurveSmooth();
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};


Examples - C++ MakeDwg - MDDlog2.cpp

MDDlog2.cpp

C++ MakeDwg Example

HRESULT GetImsigxPath(LPTSTR lpszPath)
{
    OLECHAR subKey[_MAX_PATH];

    wcscpy(subKey, L"CLSID\\");
    OLECHAR* pGuid = wcschr(subKey, 0);
    if (::StringFromGUID2(CLSID_XApplication, pGuid, _MAX_PATH) == 0)
        return E_FAIL;
    wcscat(subKey, L"\\InProcServer32");

    HKEY hKey;
    if (::RegOpenKeyExW(
        HKEY_CLASSES_ROOT,	// handle of open key
        subKey,	// address of name of subkey to open
        0,	// reserved
        KEY_READ,	// security access mask
        &hKey) 	// address of handle of open key
        != ERROR_SUCCESS)
        return E_FAIL;

    DWORD dwType;
    DWORD dwData;
    LONG lResult = ::RegQueryValueEx(
        hKey,	// handle of key to query
        NULL,	// address of name of value to query
        NULL,	// reserved
        &dwType,	// address of buffer for value type
        (LPBYTE)lpszPath,	// address of data buffer
        &dwData); 	// address of data buffer size

    ::RegCloseKey(hKey);
    return (lResult == ERROR_SUCCESS) ? S_OK : E_FAIL;
}

void CMakeDwgDlg::OnInprocServer()
{
    TCHAR szIMSIGXDLL[_MAX_PATH];
    HRESULT hRes = GetImsigxPath(szIMSIGXDLL);
    if (SUCCEEDED(hRes))
    {
        hRes = E_FAIL;
        HINSTANCE hMod = ::LoadLibrary(szIMSIGXDLL);
        if (hMod != NULL)
        {
            HRESULT (*GetApp)(IApplication**) =
                (HRESULT (*)(IApplication**))
                ::GetProcAddress(hMod, "IMSIGXGetXApplication");
            if (GetApp != NULL)
                hRes = (*GetApp)(&m_pIApplication);
            // ::FreeLibrary(szIMSIGXDLL);
        }
        else
        {
            DWORD dwLastError = GetLastError();
            hRes = E_FAIL;
        }
    }

    if (FAILED(hRes))
    {
        AfxMessageBox("Couldn't create application object (in-process server)!");
    }

    EnableButtons();
}


Examples - C++ MakeDwg - VPWnd.cpp

VPWnd.cpp

C++ MakeDwg Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// VPWnd.cpp : implementation file
// TurboCAD SDK: new class implementation

#include "stdafx.h"
#include "MakeDwg.h"
#include "VPWnd.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CViewWnd
// TurboCAD SDK: class created to manage view on dialog box

CViewWnd::CViewWnd() :
    m_pView(NULL),
    m_pIDrawing(NULL)
{
}

CViewWnd::~CViewWnd()
{
    SetView(NULL);
}

BEGIN_MESSAGE_MAP(CViewWnd, CWnd)
    //{{AFX_MSG_MAP(CViewWnd)
    ON_WM_PAINT()
    ON_WM_ERASEBKGND()
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

// TurboCAD SDK: set the view, if one already exists, delete and release it
//               before assigning the new one.
void CViewWnd::SetView(View* pView)
{
    if (m_pView != NULL)
    {
        // Delete view object
        m_pView->Delete();

        // Decrement reference count
        m_pView->Release();
        m_pView = NULL;
        if (m_pIDrawing != NULL)
        {
            m_pIDrawing->Release();
            m_pIDrawing = NULL;
        }
    }

    if (pView == NULL)
        return;

    m_pView = pView;

    // Increment reference count
    m_pView->AddRef();

    // Map window to view
    m_pView->put_HWND((long)m_hWnd);

    // Keep a reference to the drawing
    m_pView->get_Drawing(&m_pIDrawing);

    // zoom to drawing extents and invalidate the window
    ZoomAndInvalidate();
}

IDrawing* CViewWnd::GetDrawing()
{
    if (m_pIDrawing != NULL)
        m_pIDrawing->AddRef();
    return m_pIDrawing;
}

Graphics* CViewWnd::GetGraphics()
{
    Graphics* pGraphics = NULL;
    if (m_pIDrawing != NULL)
        m_pIDrawing->get_Graphics(&pGraphics);
    return pGraphics;
}

// TurboCAD SDK: zoom to drawing extents and invalidate the window
void CViewWnd::ZoomAndInvalidate()
{
    // No view, exit
    if (m_pView == NULL)
        return;

    // Zoom to extents
    HRESULT hRes = m_pView->ZoomToExtents();
    if (FAILED(hRes))
    {
    }

    // Invalidate window to force redraw
    Invalidate();
}

/////////////////////////////////////////////////////////////////////////////
// CViewWnd message handlers

// TurboCAD SDK: override OnPaint to refresh the view
void CViewWnd::OnPaint()
{
    CPaintDC dc(this); // device context for painting

    if (m_pView == NULL)
        return;

    // Force redraw of view window
    HRESULT hRes = m_pView->Refresh();
    if (FAILED(hRes))
    {
    }
}

// TurboCAD SDK: override OnEraseBkgnd to reset the drawing area
BOOL CViewWnd::OnEraseBkgnd(CDC* pDC)
{
    CRect rect;
    GetClientRect(rect);
    pDC->FillSolidRect(rect, ::GetSysColor(COLOR_WINDOW));
    return TRUE;
}


Examples - C++ MakeDwg - VPWnd.h

VPWnd.h

C++ MakeDwg Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// VPWnd.h : header file
// TurboCAD SDK: New class created to handle the drawing view on the dialog box.

/////////////////////////////////////////////////////////////////////////////
// CViewWnd window

class CViewWnd : public CWnd
{
// Construction
public:
    CViewWnd();

// Attributes
protected:
    View* m_pView;
    IDrawing* m_pIDrawing;

// Operations
public:
    // Set up the current view
    void SetView(View* pView);
    // Zoom to the extents of the drawing and refresh the window
    void ZoomAndInvalidate();
    IDrawing* GetDrawing();
    Graphics* GetGraphics();

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CViewWnd)
    //}}AFX_VIRTUAL

// Implementation
public:
    virtual ~CViewWnd();

    // Generated message map functions
protected:
    //{{AFX_MSG(CViewWnd)
    afx_msg void OnPaint();
    afx_msg BOOL OnEraseBkgnd(CDC* pDC);
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

/////////////////////////////////////////////////////////////////////////////


Examples - C++ ActiveX Control - BlockInsertDialog.cpp

BlockInsertDialog.cpp

C++ ActiveX Control Example

// BlockInsertDialog.cpp : implementation file
//

#include "stdafx.h"
#include "SDKDemo.h"
#include "BlockInsertDialog.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CBlockInsertDialog dialog

CBlockInsertDialog::CBlockInsertDialog(IDrawing* pIDrawing, CWnd* pParent /*=NULL*/) :
    CDialog(CBlockInsertDialog::IDD, pParent),
    m_pBlocks(NULL)
{
    //{{AFX_DATA_INIT(CBlockInsertDialog)
    m_strBlockName = _T("");
    //}}AFX_DATA_INIT

    if (pIDrawing != NULL)
    {
        Blocks* pBlocks = NULL;
        HRESULT hRes = pIDrawing->get_Blocks(&pBlocks);
        if (SUCCEEDED(hRes))
        {
            long lCount = 0;
            hRes = pBlocks->get_Count(&lCount);
            if (SUCCEEDED(hRes) && lCount > 0)
            {
                m_pBlocks = pBlocks;
                return;
            }
            pBlocks->Release();
        }
    }
}

CBlockInsertDialog::~CBlockInsertDialog()
{
    if (m_pBlocks != NULL)
        m_pBlocks->Release();
}

void CBlockInsertDialog::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CBlockInsertDialog)
    DDX_LBString(pDX, IDC_BLOCKS, m_strBlockName);
    //}}AFX_DATA_MAP
}

BOOL CBlockInsertDialog::OnInitDialog()
{
    CDialog::OnInitDialog();

    BOOL bSuccess = FALSE;
    if (m_pBlocks != NULL)
    {
        long lCount = 0;
        HRESULT hRes = m_pBlocks->get_Count(&lCount);
        if (SUCCEEDED(hRes) && lCount > 0)
        {
            CListBox* pList = (CListBox*)GetDlgItem(IDC_BLOCKS);
            for (long i = 0; i < lCount; ++i)
            {
                Block* pBlock = NULL;
                COleVariant varIndex(i);
                hRes = m_pBlocks->get_Item(&varIndex, &pBlock);
                if (SUCCEEDED(hRes))
                {
                    BSTR bstrName = NULL;
                    hRes = pBlock->get_Name(&bstrName);
                    if (SUCCEEDED(hRes))
                    {
                        CString str(bstrName);
                        SysFreeString(bstrName);

                        if (pList->AddString(str) != LB_ERR)
                            bSuccess = TRUE;
                    }
                }
            }
        }
    }
    if (!bSuccess)
        EndDialog(IDCANCEL);
    return TRUE;
}

BEGIN_MESSAGE_MAP(CBlockInsertDialog, CDialog)
    //{{AFX_MSG_MAP(CBlockInsertDialog)
    ON_LBN_DBLCLK(IDC_BLOCKS, OnDblclkBlocks)
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CBlockInsertDialog message handlers

void CBlockInsertDialog::OnDblclkBlocks()
{
    UpdateData(TRUE);
    EndDialog(IDOK);
}


Examples - C++ ActiveX Control - BlockInsertDialog.h

BlockInsertDialog.h

C++ ActiveX Control Example

// BlockInsertDialog.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CBlockInsertDialog dialog

class CBlockInsertDialog : public CDialog
{
// Construction
public:
    CBlockInsertDialog(IDrawing* pIDrawing, CWnd* pParent = NULL);   // standard constructor
    ~CBlockInsertDialog();

// Dialog Data
    //{{AFX_DATA(CBlockInsertDialog)
    enum { IDD = IDD_BLK_INSERT };
    CString	m_strBlockName;
    //}}AFX_DATA
    Blocks* m_pBlocks;

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CBlockInsertDialog)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL
    virtual BOOL OnInitDialog();

// Implementation
protected:

    // Generated message map functions
    //{{AFX_MSG(CBlockInsertDialog)
    afx_msg void OnDblclkBlocks();
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};


Examples - C++ ActiveX Control - SDKDemo.cpp

SDKDemo.cpp

C++ ActiveX Control Example

// SDKDemo.cpp : Implementation of CSDKDemoApp and DLL registration.

#include "stdafx.h"
#include "SDKDemo.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

CSDKDemoApp NEAR theApp;

const GUID CDECL BASED_CODE _tlid =
        { 0xa63e6661, 0xc85f, 0x11d0, { 0x9b, 0x3b, 0x44, 0x45, 0x53, 0x54, 0, 0 } };
const WORD _wVerMajor = 1;
const WORD _wVerMinor = 0;

////////////////////////////////////////////////////////////////////////////
// CSDKDemoApp::InitInstance - DLL initialization

BOOL CSDKDemoApp::InitInstance()
{
    BOOL bInit = COleControlModule::InitInstance();

    if (bInit)
    {
        // TODO: Add your own module initialization code here.
    }

    return bInit;
}

////////////////////////////////////////////////////////////////////////////
// CSDKDemoApp::ExitInstance - DLL termination

int CSDKDemoApp::ExitInstance()
{
    // TODO: Add your own module termination code here.

    return COleControlModule::ExitInstance();
}

/////////////////////////////////////////////////////////////////////////////
// DllRegisterServer - Adds entries to the system registry

STDAPI DllRegisterServer(void)
{
    AFX_MANAGE_STATE(_afxModuleAddrThis);

    if (!AfxOleRegisterTypeLib(AfxGetInstanceHandle(), _tlid))
        return ResultFromScode(SELFREG_E_TYPELIB);

    if (!COleObjectFactoryEx::UpdateRegistryAll(TRUE))
        return ResultFromScode(SELFREG_E_CLASS);

    return NOERROR;
}

/////////////////////////////////////////////////////////////////////////////
// DllUnregisterServer - Removes entries from the system registry

STDAPI DllUnregisterServer(void)
{
    AFX_MANAGE_STATE(_afxModuleAddrThis);

    if (!AfxOleUnregisterTypeLib(_tlid, _wVerMajor, _wVerMinor))
        return ResultFromScode(SELFREG_E_TYPELIB);

    if (!COleObjectFactoryEx::UpdateRegistryAll(FALSE))
        return ResultFromScode(SELFREG_E_CLASS);

    return NOERROR;
}


Examples - C++ ActiveX Control - SDKDemoCtl.cpp

SDKDemoCtl.cpp

C++ ActiveX Control Example

// SDKDemoCtl.cpp : Implementation of the CSDKDemoCtrl OLE control class.

#include "stdafx.h"
#include "SDKDemo.h"
#include "SDKDemoCtl.h"
#include "SDKDemoPpg.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

// Make a "missing" optional parameter
COleVariant varMissing((long)DISP_E_PARAMNOTFOUND, VT_ERROR);

IMPLEMENT_DYNCREATE(CSDKDemoCtrl, COleControl)

/////////////////////////////////////////////////////////////////////////////
// Message map

BEGIN_MESSAGE_MAP(CSDKDemoCtrl, COleControl)
    //{{AFX_MSG_MAP(CSDKDemoCtrl)
    ON_WM_CREATE()
    ON_WM_LBUTTONDOWN()
    ON_WM_LBUTTONUP()
    ON_WM_MOUSEMOVE()
    //}}AFX_MSG_MAP
    ON_OLEVERB(AFX_IDS_VERB_EDIT, OnEdit)
    ON_OLEVERB(AFX_IDS_VERB_PROPERTIES, OnProperties)
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// Dispatch map

BEGIN_DISPATCH_MAP(CSDKDemoCtrl, COleControl)
    //{{AFX_DISPATCH_MAP(CSDKDemoCtrl)
    DISP_PROPERTY_NOTIFY(CSDKDemoCtrl, "FileName", m_strFileName, OnFileNameChanged, VT_BSTR)
    DISP_PROPERTY_NOTIFY(CSDKDemoCtrl, "HideLayers", m_strHideLayers, OnHideLayersChanged, VT_BSTR)
    DISP_PROPERTY_EX(CSDKDemoCtrl, "AllLayers", GetAllLayers, SetNotSupported, VT_BSTR)
    DISP_STOCKPROP_BACKCOLOR()
    //}}AFX_DISPATCH_MAP
    //}}AFX_DISPATCH_MAP
    DISP_FUNCTION_ID(CSDKDemoCtrl, "AboutBox", DISPID_ABOUTBOX, AboutBox, VT_EMPTY, VTS_NONE)
END_DISPATCH_MAP()

/////////////////////////////////////////////////////////////////////////////
// Event map

BEGIN_EVENT_MAP(CSDKDemoCtrl, COleControl)
    //{{AFX_EVENT_MAP(CSDKDemoCtrl)
    // NOTE - ClassWizard will add and remove event map entries
    //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_EVENT_MAP
END_EVENT_MAP()

/////////////////////////////////////////////////////////////////////////////
// Property pages

// TODO: Add more property pages as needed.  Remember to increase the count!
BEGIN_PROPPAGEIDS(CSDKDemoCtrl, 1)
    PROPPAGEID(CSDKDemoPropPage::guid)
END_PROPPAGEIDS(CSDKDemoCtrl)

/////////////////////////////////////////////////////////////////////////////
// Initialize class factory and guid

IMPLEMENT_OLECREATE_EX(CSDKDemoCtrl, "SDKDEMO.SDKDemoCtrl.1",
    0xa63e6664, 0xc85f, 0x11d0, 0x9b, 0x3b, 0x44, 0x45, 0x53, 0x54, 0, 0)

/////////////////////////////////////////////////////////////////////////////
// Type library ID and version

IMPLEMENT_OLETYPELIB(CSDKDemoCtrl, _tlid, _wVerMajor, _wVerMinor)

/////////////////////////////////////////////////////////////////////////////
// Interface IDs

const IID BASED_CODE IID_DSDKDemo =
        { 0xa63e6662, 0xc85f, 0x11d0, { 0x9b, 0x3b, 0x44, 0x45, 0x53, 0x54, 0, 0 } };
const IID BASED_CODE IID_DSDKDemoEvents =
        { 0xa63e6663, 0xc85f, 0x11d0, { 0x9b, 0x3b, 0x44, 0x45, 0x53, 0x54, 0, 0 } };

/////////////////////////////////////////////////////////////////////////////
// Control type information

static const DWORD BASED_CODE _dwSDKDemoOleMisc =
    OLEMISC_ACTIVATEWHENVISIBLE |
    OLEMISC_SETCLIENTSITEFIRST |
    OLEMISC_INSIDEOUT |
    OLEMISC_CANTLINKINSIDE |
    OLEMISC_RECOMPOSEONRESIZE;

IMPLEMENT_OLECTLTYPE(CSDKDemoCtrl, IDS_SDKDEMO, _dwSDKDemoOleMisc)

/////////////////////////////////////////////////////////////////////////////
// CSDKDemoCtrl::CSDKDemoCtrlFactory::UpdateRegistry -
// Adds or removes system registry entries for CSDKDemoCtrl

BOOL CSDKDemoCtrl::CSDKDemoCtrlFactory::UpdateRegistry(BOOL bRegister)
{
    // TODO: Verify that your control follows apartment-model threading rules.
    // Refer to MFC TechNote 64 for more information.
    // If your control does not conform to the apartment-model rules, then
    // you must modify the code below, changing the 6th parameter from
    // afxRegInsertable | afxRegApartmentThreading to afxRegInsertable.

    if (bRegister)
        return AfxOleRegisterControlClass(
            AfxGetInstanceHandle(),
            m_clsid,
            m_lpszProgID,
            IDS_SDKDEMO,
            IDB_SDKDEMO,
            afxRegInsertable | afxRegApartmentThreading,
            _dwSDKDemoOleMisc,
            _tlid,
            _wVerMajor,
            _wVerMinor);
    else
        return AfxOleUnregisterClass(m_clsid, m_lpszProgID);
}

/////////////////////////////////////////////////////////////////////////////
// CSDKDemoCtrl::CSDKDemoCtrl - Constructor

CSDKDemoCtrl::CSDKDemoCtrl() :
    m_bFirstDraw(TRUE),
    m_pIApp(NULL),
    m_pIDrawing(NULL),
    m_pView(NULL),
    m_ptMouseDown(CPoint(0, 0)),
    m_dragX(0),
    m_dragY(0),
    m_bDragging(FALSE),
    m_pDragGraphic(NULL)
{
    InitializeIIDs(&IID_DSDKDemo, &IID_DSDKDemoEvents);
    VariantInit(&m_dragOutline);
}

/////////////////////////////////////////////////////////////////////////////
// CSDKDemoCtrl::~CSDKDemoCtrl - Destructor

CSDKDemoCtrl::~CSDKDemoCtrl()
{
    VariantClear(&m_dragOutline);
    CloseDrawing();
    if (m_pIApp != NULL)
        m_pIApp->Release();
}

BOOL CSDKDemoCtrl::OpenDrawing(const CString& strFileName)
{
    if (m_pIApp == NULL)
        return FALSE;

    Drawings* pDrawings;
    HRESULT hRes = m_pIApp->get_Drawings(&pDrawings);
    if (FAILED(hRes))
        return FALSE;

    // Get the file name into a BSTR
    BSTR bstrPath = strFileName.AllocSysString();

    // Add the drawing to the drawings collection
    IDrawing* pIDrawing;
    hRes = pDrawings->Open(bstrPath, &varMissing, &varMissing, &pIDrawing);

    // Free the system memory for the BSTR
    ::SysFreeString(bstrPath);

    if (SUCCEEDED(hRes))
    {
        Views* pViews;
        hRes = pIDrawing->get_Views(&pViews);
        if (SUCCEEDED(hRes))
        {
            View* pView;
            hRes = pViews->Add(&varMissing, &varMissing, &pView);
            if (SUCCEEDED(hRes))
            {
                CloseDrawing();

                m_pIDrawing = pIDrawing;
                m_pView = pView;
                Layers* pLayers;
                if (SUCCEEDED(m_pIDrawing->get_Layers(&pLayers)))
                {
                    COleVariant varIndex(0L);
                    for ( ; ; varIndex.lVal++)
                    {
                        Layer* pLayer;
                        if (FAILED(pLayers->get_Item(&varIndex, &pLayer)))
                            break;
                        BSTR bstrName = NULL;
                        if (SUCCEEDED(pLayer->get_Name(&bstrName)))
                        {
                            CString str(bstrName);
                            if (!m_strAllLayers.IsEmpty())
                                m_strAllLayers += "\n";
                            m_strAllLayers += str;
                            ::SysFreeString(bstrName);
                        }
                    }
                }
                InvalidateControl();
            }
            pViews->Release();
        }
        if (FAILED(hRes))
        {
            pIDrawing->Close(&varMissing, &varMissing, &varMissing);
            pIDrawing->Release();
        }
    }
    pDrawings->Release();
    return SUCCEEDED(hRes);
}

void CSDKDemoCtrl::CloseDrawing()
{
    if (m_pDragGraphic != NULL)
    {
        m_pDragGraphic->Release();
        m_pDragGraphic = NULL;
    }
    m_bDragging = FALSE;

    m_strAllLayers.Empty();
    m_strHideLayers.Empty();
    if (m_pView != NULL)
    {
        m_pView->Release();
        m_pView = NULL;
    }
    if (m_pIDrawing != NULL)
    {
        m_pIDrawing->Close(&varMissing, &varMissing, &varMissing);
        m_pIDrawing->Release();
        m_pIDrawing = NULL;
    }
    m_bFirstDraw = TRUE;
}

/////////////////////////////////////////////////////////////////////////////
// CSDKDemoCtrl::OnDraw - Drawing function

void CSDKDemoCtrl::OnDraw(
            CDC* pdc, const CRect& rcBounds, const CRect& rcInvalid)
{
    {
        CBrush colorBrush;
        CBrush* backBrush;
        if (m_pView == NULL)
            backBrush = CBrush::FromHandle((HBRUSH)GetStockObject(LTGRAY_BRUSH));
        else
        {
            colorBrush.CreateSolidBrush(GetBackColor());
            backBrush = &colorBrush;
        }
        pdc->FillRect(rcBounds, backBrush);
    }
    if (m_pView == NULL)
        return;

    HDC hDC = pdc->m_hDC;
    m_pView->put_Update(FALSE);
    m_pView->put_DC((long)hDC);
    m_pView->put_MappingMode(MM_TEXT);
    m_pView->put_Margins(FALSE);
    m_pView->put_FixedAspectRatio(TRUE);
    m_pView->put_ScreenLeft(rcBounds.left);
    m_pView->put_ScreenTop(rcBounds.top);
    m_pView->put_ScreenWidth(rcBounds.Width());
    m_pView->put_ScreenHeight(rcBounds.Height());
    if (m_bFirstDraw)
    {
        m_bFirstDraw = FALSE;
        m_pView->ZoomToExtents();
    }
    m_pView->Refresh();
}

/////////////////////////////////////////////////////////////////////////////
// CSDKDemoCtrl::DoPropExchange - Persistence support

void CSDKDemoCtrl::DoPropExchange(CPropExchange* pPX)
{
    ExchangeVersion(pPX, MAKELONG(_wVerMinor, _wVerMajor));
    COleControl::DoPropExchange(pPX);

    PX_String(pPX, _T("FileName"), m_strFileName);
    PX_String(pPX, _T("HideLayers"), m_strHideLayers);
}

/////////////////////////////////////////////////////////////////////////////
// CSDKDemoCtrl::OnResetState - Reset control to default state

void CSDKDemoCtrl::OnResetState()
{
    COleControl::OnResetState();  // Resets defaults found in DoPropExchange

    // TODO: Reset any other control state here.
}

/////////////////////////////////////////////////////////////////////////////
// CSDKDemoCtrl::AboutBox - Display an "About" box to the user

void CSDKDemoCtrl::AboutBox()
{
    CDialog dlgAbout(IDD_ABOUTBOX_SDKDEMO);
    dlgAbout.DoModal();
}

/////////////////////////////////////////////////////////////////////////////
// CSDKDemoCtrl message handlers

void CSDKDemoCtrl::OnFileNameChanged()
{
    OpenDrawing(m_strFileName);
    SetModifiedFlag();
}

UINT CountStrings(const char* lpsz)
{
    if (lpsz == NULL)
        return 0;
    UINT n = 0;
    const char* p = lpsz;
    while (*p)
    {
        ++n;
        p = strchr(p, '\n');
        if (p == NULL)
            break;
        ++p;
    }
    return n;
}

BOOL CSDKDemoCtrl::PreCreateWindow(CREATESTRUCT& cs)
{
    // Connect to the server
    static const CLSID CLSID_XApplication = {0x6A481801,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
    static const IID IID_IApplication = {0x6A481101,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

    HRESULT hRes = CoCreateInstance(
        CLSID_XApplication,	//Class identifier (CLSID) of the object
        NULL,	//Object is or isn't part of an aggregate
        CLSCTX_INPROC_SERVER,	//Context for running executable code
        IID_IApplication,	//Interface identifier
        (void**)&m_pIApp	//Points to requested interface pointer
    );

    if (FAILED(hRes))
    {
        AfxMessageBox("Couldn't create application object (in-process server)!");
        return FALSE;
    }

    return COleControl::PreCreateWindow(cs);
}

int CSDKDemoCtrl::OnCreate(LPCREATESTRUCT lpCreateStruct)
{
    if (COleControl::OnCreate(lpCreateStruct) == -1)
        return -1;

    // If we are started from a property set with a FileName
    // tTry to open the drawing now
    if (!m_strFileName.IsEmpty())
        OpenDrawing(m_strFileName);

    return 0;
}

void CSDKDemoCtrl::OnHideLayersChanged()
{
    if (m_pIDrawing != NULL)
    {
        Layers* pLayers;
        if (SUCCEEDED(m_pIDrawing->get_Layers(&pLayers)))
        {
            COleVariant varIndex(0L);
            for ( ; ; varIndex.lVal++)
            {
                Layer* pLayer;
                if (FAILED(pLayers->get_Item(&varIndex, &pLayer)))
                    break;
                pLayer->put_Visible(TRUE);
                pLayer->Release();
            }
            for (int i = 0; ; i++)
            {
                CString str;
                if (!AfxExtractSubString(str, m_strHideLayers, i, '\n'))
                    break;
                if (!str.IsEmpty())
                {
                    Layer* pLayer;
                    COleVariant varName(str);
                    if (SUCCEEDED(pLayers->get_Item(&varName, &pLayer)))
                    {
                        pLayer->put_Visible(FALSE);
                        pLayer->Release();
                    }
                }
            }
        }
    }

    SetModifiedFlag();
}

BSTR CSDKDemoCtrl::GetAllLayers()
{
    return m_strAllLayers.AllocSysString();
}

BOOL CSDKDemoCtrl::BeginDrag(const CPoint& point)
{
    VariantClear(&m_dragOutline);
    SAFEARRAYBOUND bound;
    bound.cElements = 0;
    bound.lLbound = 0;
    m_dragOutline.vt = VT_ARRAY|VT_R8;
    m_dragOutline.parray = ::SafeArrayCreate(VT_R8, 1, &bound);
    HRESULT hRes = m_pDragGraphic->CreateDragOutline(&m_dragOutline);
    if (FAILED(hRes))
        return FALSE;

    m_bDragging = TRUE;
    m_pDragGraphic->put_Visible(FALSE);
    InvalidateControl();
    UpdateWindow();

    SetCapture();
    CDC* pDC = GetDC();
    m_pView->put_DC((long)pDC->m_hDC);
    VARIANT varState;
    varState.vt = VT_I4;
    varState.lVal = imsiDragBegin;
    hRes = m_pView->DragOutline(&m_dragOutline, m_ptMouseDown.x, m_ptMouseDown.y, &varState);
    varState.lVal = imsiDragContinue;
    hRes = m_pView->DragOutline(&m_dragOutline, point.x, point.y, &varState);
    ReleaseDC(pDC);
    return TRUE;
}

void CSDKDemoCtrl::Drag(const CPoint& point)
{
    if (m_pView == NULL)
        return;

    CDC* pDC = GetDC();
    m_pView->put_DC((long)pDC->m_hDC);
    VARIANT varState;
    varState.vt = VT_I4;
    varState.lVal = imsiDragContinue;
    HRESULT hRes = m_pView->DragOutline(&m_dragOutline, point.x, point.y, &varState);
    ReleaseDC(pDC);
}

void CSDKDemoCtrl::EndDrag(const CPoint& point)
{
    m_bDragging = FALSE;
    ReleaseCapture();
    if (m_pView == NULL || m_pDragGraphic == NULL)
        return;

    CDC* pDC = GetDC();
    m_pView->put_DC((long)pDC->m_hDC);
    VARIANT varState;
    varState.vt = VT_I4;
    varState.lVal = imsiDragEnd;
    HRESULT hRes = m_pView->DragOutline(&m_dragOutline, point.x, point.y, &varState);
    ReleaseDC(pDC);

    VariantClear(&m_dragOutline);

    double dx, dy;
    hRes = m_pView->ScreenToView(point.x, point.y, &dx, &dy);
    dx -= m_dragX;
    dy -= m_dragY;
    hRes = m_pDragGraphic->MoveRelative(dx, dy, 0.0, NULL);
    m_pDragGraphic->put_Visible(TRUE);
    m_pDragGraphic->Release();
    m_pDragGraphic = NULL;
    InvalidateControl();
}

void CSDKDemoCtrl::OnLButtonDown(UINT nFlags, CPoint point)
{
    m_ptMouseDown = point;
    if (m_pDragGraphic != NULL)
    {
        m_pDragGraphic->Release();
        m_pDragGraphic = NULL;
    }

    if (m_pView != NULL)
    {
        HRESULT hRes = m_pView->ScreenToView(point.x, point.y, &m_dragX, &m_dragY);
        PickResult* pickResult;
        hRes = m_pView->PickPoint(m_dragX, m_dragY,
            &varMissing, // Aperture
            &varMissing, // TopLevel,
            &varMissing, // Arcs
            &varMissing, // Text
            &varMissing, // Segments
            &varMissing, // Blocks
            &varMissing, // Invisible
            &pickResult);
        if (SUCCEEDED(hRes))
        {
            long lCount = 0;
            hRes = pickResult->get_Count(&lCount);
            if (lCount > 0)
            {
                COleVariant varIndex(0L);
                PickEntry* pickEntry;
                hRes = pickResult->get_Item(&varIndex, &pickEntry);
                if (SUCCEEDED(hRes))
                {
                    IGraphic* pIGraphic;
                    hRes = pickEntry->get_Graphic(&pIGraphic);
                    if (SUCCEEDED(hRes))
                        m_pDragGraphic = pIGraphic;
                    pickEntry->Release();
                }
            }
            pickResult->Release();
        }
    }

    COleControl::OnLButtonDown(nFlags, point);
}

void CSDKDemoCtrl::OnLButtonUp(UINT nFlags, CPoint point)
{
    if (m_bDragging)
        EndDrag(point);
    else if (m_pDragGraphic != NULL)
    {
        m_pDragGraphic->Release();
        m_pDragGraphic = NULL;
    }

    COleControl::OnLButtonUp(nFlags, point);
}

void CSDKDemoCtrl::OnMouseMove(UINT nFlags, CPoint point)
{
    if (m_pDragGraphic != NULL && !m_bDragging && (nFlags & MK_LBUTTON))
    {
        if (!BeginDrag(point))
        {
            m_pDragGraphic->Release();
            m_pDragGraphic = NULL;
        }
    }
    else if (m_bDragging)
    {
        if (nFlags & MK_LBUTTON)
            Drag(point);
        else
            EndDrag(point);
    }

    COleControl::OnMouseMove(nFlags, point);
}


Examples - C++ ActiveX Control - SDKDemoCtl.h

SDKDemoCtl.h

C++ ActiveX Control Example

// SDKDemoCtl.h : Declaration of the CSDKDemoCtrl OLE control class.

/////////////////////////////////////////////////////////////////////////////
// CSDKDemoCtrl : See SDKDemoCtl.cpp for implementation.

class CSDKDemoCtrl : public COleControl
{
    DECLARE_DYNCREATE(CSDKDemoCtrl)

// Constructor
public:
    CSDKDemoCtrl();

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CSDKDemoCtrl)
    public:
    virtual void OnDraw(CDC* pdc, const CRect& rcBounds, const CRect& rcInvalid);
    virtual void DoPropExchange(CPropExchange* pPX);
    virtual void OnResetState();
    protected:
    virtual BOOL PreCreateWindow(CREATESTRUCT& cs);
    //}}AFX_VIRTUAL

// Implementation
protected:
    CString m_strAllLayers;
    BOOL m_bFirstDraw;
    IApplication* m_pIApp;
    IDrawing* m_pIDrawing;
    View* m_pView;
    CPoint m_ptMouseDown;
    double m_dragX;
    double m_dragY;
    VARIANT m_dragOutline;
    IGraphic* m_pDragGraphic;
    BOOL m_bDragging;

    ~CSDKDemoCtrl();
    BOOL OpenDrawing(const CString& strFileName);
    void CloseDrawing();
    BOOL BeginDrag(const CPoint& point);
    void Drag(const CPoint& point);
    void EndDrag(const CPoint& point);

    DECLARE_OLECREATE_EX(CSDKDemoCtrl)    // Class factory and guid
    DECLARE_OLETYPELIB(CSDKDemoCtrl)      // GetTypeInfo
    DECLARE_PROPPAGEIDS(CSDKDemoCtrl)     // Property page IDs
    DECLARE_OLECTLTYPE(CSDKDemoCtrl)		// Type name and misc status

// Message maps
    //{{AFX_MSG(CSDKDemoCtrl)
    afx_msg int OnCreate(LPCREATESTRUCT lpCreateStruct);
    afx_msg void OnLButtonDown(UINT nFlags, CPoint point);
    afx_msg void OnLButtonUp(UINT nFlags, CPoint point);
    afx_msg void OnMouseMove(UINT nFlags, CPoint point);
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()

// Dispatch maps
    //{{AFX_DISPATCH(CSDKDemoCtrl)
    CString m_strFileName;
    afx_msg void OnFileNameChanged();
    CString m_strHideLayers;
    afx_msg void OnHideLayersChanged();
    afx_msg BSTR GetAllLayers();
    //}}AFX_DISPATCH
    DECLARE_DISPATCH_MAP()

    afx_msg void AboutBox();

// Event maps
    //{{AFX_EVENT(CSDKDemoCtrl)
    //}}AFX_EVENT
    DECLARE_EVENT_MAP()

// Dispatch and event IDs
public:
    enum {
    //{{AFX_DISP_ID(CSDKDemoCtrl)
    dispidFileName = 1L,
    dispidHideLayers = 2L,
    dispidAllLayers = 3L,
    //}}AFX_DISP_ID
    };
};


Examples - C++ ActiveX Control - SDKDemo.h

SDKDemo.h

C++ ActiveX Control Example

// SDKDemo.h : main header file for SDKDEMO.DLL

#if !defined( __AFXCTL_H__ )
    #error include 'afxctl.h' before including this file
#endif

#include "resource.h"       // main symbols

/////////////////////////////////////////////////////////////////////////////
// CSDKDemoApp : See SDKDemo.cpp for implementation.

class CSDKDemoApp : public COleControlModule
{
public:
    BOOL InitInstance();
    int ExitInstance();
};

extern const GUID CDECL _tlid;
extern const WORD _wVerMajor;
extern const WORD _wVerMinor;


Examples - C++ ActiveX Control - SDKDemoPpg.cpp

SDKDemoPpg.cpp

C++ ActiveX Control Example

// SDKDemoPpg.cpp : Implementation of the CSDKDemoPropPage property page class.

#include "stdafx.h"
#include "SDKDemo.h"
#include "SDKDemoPpg.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

IMPLEMENT_DYNCREATE(CSDKDemoPropPage, COlePropertyPage)

/////////////////////////////////////////////////////////////////////////////
// Message map

BEGIN_MESSAGE_MAP(CSDKDemoPropPage, COlePropertyPage)
    //{{AFX_MSG_MAP(CSDKDemoPropPage)
    ON_BN_CLICKED(IDC_FILE_BROWSE, OnFileBrowse)
    ON_BN_CLICKED(IDC_LAYER_REFRESH, OnLayerRefresh)
    ON_BN_CLICKED(IDC_LAYER_SHOW_ALL, OnLayerShowAll)
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// Initialize class factory and guid

IMPLEMENT_OLECREATE_EX(CSDKDemoPropPage, "SDKDEMO.SDKDemoPropPage.1",
    0xa63e6665, 0xc85f, 0x11d0, 0x9b, 0x3b, 0x44, 0x45, 0x53, 0x54, 0, 0)

/////////////////////////////////////////////////////////////////////////////
// CSDKDemoPropPage::CSDKDemoPropPageFactory::UpdateRegistry -
// Adds or removes system registry entries for CSDKDemoPropPage

BOOL CSDKDemoPropPage::CSDKDemoPropPageFactory::UpdateRegistry(BOOL bRegister)
{
    if (bRegister)
        return AfxOleRegisterPropertyPageClass(AfxGetInstanceHandle(),
            m_clsid, IDS_SDKDEMO_PPG);
    else
        return AfxOleUnregisterClass(m_clsid, NULL);
}

/////////////////////////////////////////////////////////////////////////////
// CSDKDemoPropPage::CSDKDemoPropPage - Constructor

CSDKDemoPropPage::CSDKDemoPropPage() :
    COlePropertyPage(IDD, IDS_SDKDEMO_PPG_CAPTION)
{
    //{{AFX_DATA_INIT(CSDKDemoPropPage)
    m_strFileName = _T("");
    //}}AFX_DATA_INIT
}

/////////////////////////////////////////////////////////////////////////////
// CSDKDemoPropPage::DoDataExchange - Moves data between page and properties

void CSDKDemoPropPage::DoDataExchange(CDataExchange* pDX)
{
    //{{AFX_DATA_MAP(CSDKDemoPropPage)
    DDX_Control(pDX, IDC_VISIBLE_LAYERS, m_lbLayers);
    DDP_Text(pDX, IDC_FILE_NAME, m_strFileName, _T("FileName") );
    DDX_Text(pDX, IDC_FILE_NAME, m_strFileName);
    DDV_MaxChars(pDX, m_strFileName, 256);
    //}}AFX_DATA_MAP

    CString strLayers;
    DDP_Text(pDX, IDC_VISIBLE_LAYERS, strLayers, _T("HideLayers"));

    if (!pDX->m_bSaveAndValidate)
        OnLayerRefresh();
    int nTotalCount = m_lbLayers.GetCount();
    int* rgSel = new int[nTotalCount > 0 ? nTotalCount : 1];
    if (pDX->m_bSaveAndValidate)
    {
        int nSelCount = m_lbLayers.GetSelItems(nTotalCount, rgSel);
        for (int i = 0; i < nSelCount; ++i)
        {
            CString str;
            m_lbLayers.GetText(rgSel[i], str);
            if (!str.IsEmpty())
            {
                if (!strLayers.IsEmpty())
                    strLayers += "\n";
                strLayers += str;
            }
        }
    }
    else
    {
        for (int i = 0; i < nTotalCount; ++i)
            m_lbLayers.SetSel(i, FALSE);
        for (i = 0; ; ++i)
        {
            CString str;
            if (!AfxExtractSubString(str, strLayers, i, '\n'))
                break;
            if (!str.IsEmpty())
            {
                int nFind = m_lbLayers.FindStringExact(-1, str);
                if (nFind < 0)
                    nFind = m_lbLayers.AddString(str);
                if (nFind >= 0)
                    m_lbLayers.SetSel(nFind, TRUE);
            }
        }
    }
    delete [] rgSel;
    DDP_PostProcessing(pDX);
}

/////////////////////////////////////////////////////////////////////////////
// CSDKDemoPropPage message handlers

void CSDKDemoPropPage::OnFileBrowse()
{
    static TCHAR BASED_CODE szFilter[] = "TurboCAD Drawing Files (*.tcw)|*.tcw|All Files (*.*)|*.*||";
    CFileDialog dlg(TRUE, NULL, NULL, OFN_HIDEREADONLY | OFN_OVERWRITEPROMPT, szFilter, this);
    if (dlg.DoModal() == IDOK && !dlg.GetPathName().IsEmpty())
    {
        m_strFileName = dlg.GetPathName();
        CDataExchange dx(this, FALSE);
        CDataExchange* pDX = &dx;
        DDX_Text(pDX, IDC_FILE_NAME, m_strFileName);
    }
}

void CSDKDemoPropPage::OnLayerRefresh()
{
    COleDispatchDriver PropDispDriver;
    ULONG nObjects;
    LPDISPATCH* ppDisp = GetObjectArray(&nObjects);
    for (ULONG i = 0; i < nObjects; i++)
    {
        DISPID dwDispID;
        LPCOLESTR lpOleStr = OLESTR("AllLayers");
        if (SUCCEEDED(ppDisp[i]->GetIDsOfNames(IID_NULL, (LPOLESTR*)&lpOleStr, 1, 0, &dwDispID)))
        {
            CString strLayers;
            PropDispDriver.AttachDispatch(ppDisp[i], FALSE);
            PropDispDriver.GetProperty(dwDispID, VT_BSTR, &strLayers);
            PropDispDriver.DetachDispatch();
            for (int j = 0; ; ++j)
            {
                CString str;
                if (!AfxExtractSubString(str, strLayers, j, '\n'))
                    break;
                if (!str.IsEmpty())
                {
                    int nFind = m_lbLayers.FindStringExact(-1, str);
                    if (nFind < 0)
                        nFind = m_lbLayers.AddString(str);
                }
            }
        }
    }
}

void CSDKDemoPropPage::OnLayerShowAll()
{
    if (m_hWnd != NULL)
    {
        OnLayerRefresh();
        int nCount = m_lbLayers.GetCount();
        for (int i = 0; i < nCount; ++i)
        {
            m_lbLayers.SetSel(i, FALSE);
        }
    }
    SetModifiedFlag();
}


Examples - C++ ActiveX Control - SDKDemoPpg.h

SDKDemoPpg.h

C++ ActiveX Control Example

// SDKDemoPpg.h : Declaration of the CSDKDemoPropPage property page class.

////////////////////////////////////////////////////////////////////////////
// CSDKDemoPropPage : See SDKDemoPpg.cpp.cpp for implementation.

class CSDKDemoPropPage : public COlePropertyPage
{
    DECLARE_DYNCREATE(CSDKDemoPropPage)
    DECLARE_OLECREATE_EX(CSDKDemoPropPage)

// Constructor
public:
    CSDKDemoPropPage();

// Dialog Data
    //{{AFX_DATA(CSDKDemoPropPage)
    enum { IDD = IDD_PROPPAGE_SDKDEMO };
    CListBox	m_lbLayers;
    CString	m_strFileName;
    //}}AFX_DATA

// Implementation
protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support

// Message maps
protected:
    //{{AFX_MSG(CSDKDemoPropPage)
    afx_msg void OnFileBrowse();
    afx_msg void OnLayerRefresh();
    afx_msg void OnLayerShowAll();
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()

};


Examples - C++ JPEG Filter - AutoJPEG.cpp

AutoJPEG.cpp

C++ JPEG Filter Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// AutoJPEG.cpp : implementation file
//

#include "stdafx.h"
#include "JPEG.h"
#include "AutoJPEG.h" // This class

// How to create a JPEG?
#ifdef USE_LEADTOOOLS
// Source code license required
#else
// Exported function from JPEGLIB.DLL
__declspec(dllimport) extern "C" int DIBToJPEG(HGLOBAL hDib, LPCSTR outfilename);
#endif

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

// Standard variants
COleVariant t(-1L, VT_BOOL);
COleVariant f(0L, VT_BOOL);
COleVariant missing((long)DISP_E_PARAMNOTFOUND, VT_ERROR);

// IID's From Imsigx.i_c.
const IID IID_Graphics =
    {0x6A48110A,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_Filter =
    {0x6A48111B,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

/////////////////////////////////////////////////////////////////////////////
// CAutoJPEG

// We get all these functions from the Visual C++ ClassWizard...

IMPLEMENT_DYNCREATE(CAutoJPEG, CCmdTarget)

CAutoJPEG::CAutoJPEG()
{
    EnableAutomation();

    // To keep the application running as long as an OLE automation
    //	object is active, the constructor calls AfxOleLockApp.

    AfxOleLockApp();
}

CAutoJPEG::~CAutoJPEG()
{
    // To terminate the application when all objects created with
    // 	with OLE automation, the destructor calls AfxOleUnlockApp.

    AfxOleUnlockApp();
}

void CAutoJPEG::OnFinalRelease()
{
    // When the last reference for an automation object is released
    // OnFinalRelease is called.  The base class will automatically
    // deletes the object.  Add additional cleanup required for your
    // object before calling the base class.

    CCmdTarget::OnFinalRelease();
}

BEGIN_MESSAGE_MAP(CAutoJPEG, CCmdTarget)
    //{{AFX_MSG_MAP(CAutoJPEG)
        // NOTE - the ClassWizard will add and remove mapping macros here.
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

BEGIN_DISPATCH_MAP(CAutoJPEG, CCmdTarget)
    //{{AFX_DISPATCH_MAP(CAutoJPEG)
    DISP_PROPERTY_EX(CAutoJPEG, "ClassID", GetClassID, SetNotSupported, VT_BSTR)
    DISP_PROPERTY_EX(CAutoJPEG, "Description", GetDescription, SetNotSupported, VT_BSTR)
    DISP_PROPERTY_EX(CAutoJPEG, "Info", GetInfo, SetNotSupported, VT_BSTR)
    DISP_PROPERTY_EX(CAutoJPEG, "LastError", GetLastError, SetNotSupported, VT_BSTR)
    DISP_FUNCTION(CAutoJPEG, "CheckFlat", CheckFlat, VT_I4, VTS_DISPATCH VTS_BSTR VTS_I4 VTS_PVARIANT)
    DISP_FUNCTION(CAutoJPEG, "PreviewFlat", PreviewFlat, VT_I4, VTS_DISPATCH VTS_BSTR VTS_I4 VTS_I4 VTS_PBSTR VTS_PVARIANT)
    DISP_FUNCTION(CAutoJPEG, "ReadFlat", ReadFlat, VT_I4, VTS_BSTR VTS_I4 VTS_DISPATCH VTS_PVARIANT)
    DISP_FUNCTION(CAutoJPEG, "WriteFlat", WriteFlat, VT_I4, VTS_BSTR VTS_I4 VTS_DISPATCH VTS_PVARIANT)
    DISP_FUNCTION(CAutoJPEG, "ReadSetup", ReadSetup, VT_BOOL, VTS_DISPATCH)
    DISP_FUNCTION(CAutoJPEG, "WriteSetup", WriteSetup, VT_BOOL, VTS_DISPATCH)
    DISP_FUNCTION(CAutoJPEG, "Initialize", Initialize, VT_BOOL, VTS_DISPATCH)
    //}}AFX_DISPATCH_MAP
END_DISPATCH_MAP()

// Note: we add support for IID_ITurboCADFilter to support typesafe binding
//  from VBA.  This IID must match the GUID that is attached to the
//  dispinterface in the .ODL file.  Do not change this GUID if make your own custom filter!

// {6A481302-E531-11CF-A115-00A024158DAF}
static const IID IID_ITurboCADFilter =
{0x6A481302,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

BEGIN_INTERFACE_MAP(CAutoJPEG, CCmdTarget)
    INTERFACE_PART(CAutoJPEG, IID_ITurboCADFilter, Dispatch)
END_INTERFACE_MAP()

// Note: if you make a custom filter by copying this file, make sure to replace the following
//  GUID with a new GUID that matches the uuid statement in the coclass declaration in the
//  .ODL file.  This is the GUID that OLE will use to register and create the automation object.

// {28696026-B7E6-11D0-9B3B-444553540000}
IMPLEMENT_OLECREATE(CAutoJPEG, "JPEG.AutoJPEG", 0x28696026, 0xb7e6, 0x11d0, 0x9b, 0x3b, 0x44, 0x45, 0x53, 0x54, 0x0, 0x0)

/////////////////////////////////////////////////////////////////////////////
// CAutoJPEG message handlers

// GetClassID:  return the filter's class id, as a string.

BSTR CAutoJPEG::GetClassID()
{
    // Convert our GUID (see IMPLEMENT_OLECREATE macro) to a string
    LPOLESTR olestr;
    HRESULT hRes = ::StringFromCLSID(guid, &olestr);
    if (FAILED(hRes))
        return NULL;

    BSTR bstr = ::SysAllocString(olestr);
    CoTaskMemFree(olestr);
    return bstr;
}

// GetDescription:  return the filter's description.

BSTR CAutoJPEG::GetDescription()
{
    // Get the description from the resource
    CString strResult;
    strResult.LoadString(IDS_AUTOJPEG_DESC);

    return strResult.AllocSysString();
}

// GetInfo:  return the filter's info string
// Our info string is "JPEG.AutoJPEG,JPEG (JFIF) File,0,10,JPG,JPG", stored in the DLL's
// resource.

// The info string contains the following fields, delimited by commas:
// Field Name                                Value
// 1.    Filter ID                           "JPEG.AutoJPEG"
//        Used as the internal name (must be unique).
//        Should be the same as the ProgID registered for the server.
//        TurboCAD reserves names beginning with an asterisk.
// 2.    File type string for common dialog  "JPEG (JFIF) File";
//        This string appears in Windows dialog file type combo box.
// 3.    Document type handled by filter     0
//        This should always be zero for automation filters.
// 4.    Priority                            10
//        Arbitrary integer value used to determine search order for multiple filters which
//        support the same document type and file extension.
// 5.    Exported function name prefix       "JPG"
//        Not used by automation filters, but a non-blank string must be supplied.
// 6-n.  File extensions                     "JPG"
//        Used in common dialog and for matching.

BSTR CAutoJPEG::GetInfo()
{
    // Get the description from the resource
    CString strResult;
    strResult.LoadString(IDS_AUTOJPEG_INFO);

    return strResult.AllocSysString();
}

// GetLastError:  return descriptive information about the last error that occurred during an
// open or save operation.  A smarter filter would save state somewhere and return better
// diagnostics.

BSTR CAutoJPEG::GetLastError()
{
    CString strResult;
    strResult.LoadString(IDS_AUTOJPEG_ERROR_UNKNOWN);

    return strResult.AllocSysString();
}

// CheckFlat:  file readers get called with this method to see if they can read the file.
// If we were a file reader, we would look for a JPEG header.

long CAutoJPEG::CheckFlat(LPDISPATCH ThisFilter, LPCTSTR FileName, long ContextFlags, VARIANT FAR* QueryString)
{
    // We are not implementing a reader
    AfxThrowOleException(E_NOTIMPL);
    return 0;
}

// PreviewFlat:  file readers get called with this method to get a description string and a
// (bitmap or metafile) thumbnail from the file.  If we were a file reader, we would create a
// bitmap or StdPicture object from the JPEG file.

long CAutoJPEG::PreviewFlat(LPDISPATCH ThisFilter, LPCTSTR FileName, long ThumbWidth, long ThumbHeight, BSTR FAR* Description, VARIANT FAR* Thumbnail)
{
    // We are not implementing a reader
    AfxThrowOleException(E_NOTIMPL);
    return 0;
}

// ReadFlat:  file readers get called with this method to read graphics from the file and
// add to the Graphics collection.  The Drawing object that we're reading into can be
// obtained by calling Graphics->get_Drawing.

long CAutoJPEG::ReadFlat(LPCTSTR FileName, long ContextFlags, LPDISPATCH Graphics, VARIANT FAR* QueryString)
{
    // We are not implementing a reader
    AfxThrowOleException(E_NOTIMPL);
    return 0;
}

// WriteFlat:  file writers get called with this method to write graphics to the file.
// The Drawing object that we're writing from from is obtained by calling Graphics->get_Drawing.

long CAutoJPEG::WriteFlat(LPCTSTR FileName, long ContextFlags, LPDISPATCH Grfs, VARIANT FAR* QueryString)
{
    Graphics* pGraphics = NULL;
    if (FAILED(Grfs->QueryInterface(IID_Graphics, (void**)&pGraphics)))
        return -101;

#ifdef USE_LEADTOOLS
    // Source code license required!

    // If we were licensed, we could accomplish the task as follows:
    //   1. Use LEADTOOLS to get a (bitmap) DC to draw onto.
    //   2. Set up a View on our drawing with this DC.
    //   3. Refresh the View (painting onto its DC).
    //   4. Let LEADTOOLS or another utility to save the bitmap on the DC to a JPEG file.
    //   5. Destroy the DC.

#else
    // Since we're using our custom JPEG library (which expects a DIB in memory), we will:
    //   1. Set up a View on our drawing (no DC necessary).
    //   2. Open a bitmap DC on the View.
    //   3. Refresh the View (painting onto its DC).
    //   4. Close the bitamp DC and retrieve the DIB.
    //   5. Pass the DIB to our special function DIBToJPEG.
    //   6. Dispose of the memory in the DIB.

    // Copyright notice:  DIBToJPEG is an exported function, part of a DLL created using the
    //  Independent JPEG Group's JPEG encoding/decoding library, modified in part by IMSI.
    //  Please read the file "README" that is in this directory for more information on
    //  JPEG, the IJG and the JPEG library.

    long nError = -101;

    HGLOBAL hDib = NULL;
    IDrawing* pIDrawing = NULL;
    if (SUCCEEDED(pGraphics->get_Drawing(&pIDrawing)))
    {
        Views* pViews = NULL;
        if (SUCCEEDED(pIDrawing->get_Views(&pViews)))
        {
            View* pView = NULL;
            if (SUCCEEDED(pViews->Add(&missing, &missing, &pView)))
            {
                // To set the image width and height, we use settings stored in
                // TurboCAD's INI file.  These settings are transfered to our
                // WriteSetup dialog for use by us.  See comments on the WriteSetup
                // function below, and the code in WSetup.cpp for more information.
                IApplication* pIApp;
                if (SUCCEEDED(pGraphics->get_Application(&pIApp)))
                {
                    CString strProfileName;
                    if (GetProfileName(pIApp, strProfileName))
                        m_dlg.FromProfile(strProfileName);
                    pIApp->Release();
                }

                // Set up size for bitmap DC
                HRESULT hRes;
                hRes = pView->put_Update(FALSE);
                hRes = pView->put_MappingMode(MM_TEXT);
                hRes = pView->put_ScreenLeft(0.0);
                hRes = pView->put_ScreenTop(0.0);
                hRes = pView->put_ScreenWidth((double)m_dlg.m_nWidth);
                hRes = pView->put_ScreenHeight((double)m_dlg.m_nHeight);
                hRes = pView->ZoomToExtents();
                hRes = pView->put_Update(TRUE);

                // Draw our extents on the View as a bitmap
                long lBitmapDC = 0;
                hRes = pView->OpenBitmapDC(&lBitmapDC);
                if (SUCCEEDED(hRes))
                {
                    hRes = pView->Refresh();
                    hRes = pView->CloseBitmapDC((long*)&hDib);
                }

                // Done with view
                pView->Delete();
                pView->Release();
            }
            pViews->Release();
        }
        pIDrawing->Release();
    }

    if (hDib != NULL)
    {
        // Use function in JPEGLIB.DLL to save as a JPEG(JFIF) file
        // Should work with 8, 16, and 24-bit DIBs
        nError = DIBToJPEG(hDib, FileName);
        ::GlobalFree(hDib);
    }
#endif

    pGraphics->Release();
    return nError;
}

// ReadSetup:  called to allow user interface for file read settings.

BOOL CAutoJPEG::ReadSetup(LPDISPATCH ThisFilter)
{
    // We are not implementing a reader.
    AfxThrowOleException(E_NOTIMPL);

    return TRUE;
}

// WriteSetup:  called to allow user interface for file write settings.
// Our example allows users to specify the width and height of the JPEG image.
// We could (with a little more work) control the bit depth, compression, etc.

BOOL CAutoJPEG::WriteSetup(LPDISPATCH ThisFilter)
{
    // We store these settings in TurboCAD's INI file.
    // First, get the file name.
    CString strProfileName;
    if (ThisFilter != NULL)
    {
        Filter* pFilter;
        HRESULT hRes = ThisFilter->QueryInterface(IID_Filter, (void**)&pFilter);
        if (SUCCEEDED(hRes))
        {
            IApplication* pIApp;
            hRes = pFilter->get_Application(&pIApp);
            if (SUCCEEDED(hRes))
            {
                GetProfileName(pIApp, strProfileName);
                pIApp->Release();
            }
            pFilter->Release();
        }
    }

    // Initialize the setup dialog from the INI file, and run the dialog.
    if (!strProfileName.IsEmpty())
        m_dlg.FromProfile(strProfileName);
    if (m_dlg.DoModal() == IDOK)
    {
        // Update the INI file if the user clicked OK
        if (!strProfileName.IsEmpty())
            m_dlg.ToProfile(strProfileName);
    }
    return TRUE;
}

// Function called when Filter object has been added to application at startup.
// We could install an event listener here, allocate memory, or whatever.

BOOL CAutoJPEG::Initialize(LPDISPATCH ThisFilter)
{
    // We just return TRUE for success.  Returning FALSE would remove our Filter.
    return TRUE;
}

// Helper function for filter settings (accessed in WriteSetup).
// We will store our settings in TurboCAD's INI file.
// Another option is to store the settings in the Windows registry.

BOOL CAutoJPEG::GetProfileName(IApplication* pIApp, CString& strProfileName)
{
    BSTR bstrProfile;
    HRESULT hRes = pIApp->get_ProfileName(0, &bstrProfile);
    if (SUCCEEDED(hRes))
    {
        strProfileName = bstrProfile;
        ::SysFreeString(bstrProfile);
        return TRUE;
    }
    return FALSE;
}

// DUAL_SUPPORT_START
// The rest of this file is boilerplate dual interface stuff.  We use macros from MfcDual.h
// and just wrap all of our implementation functions in TRY/CATCH blocks.

// delegate standard IDispatch methods to MFC IDispatch implementation
DELEGATE_DUAL_INTERFACE(CAutoJPEG, DualJPEG)

// Our method and property functions can generally just
// delegate back to the methods we generated using
// ClassWizard. However, if we set up properties to
// access variables directly, we will need to write the
//  code to get/put the value into the variable.
STDMETHODIMP CAutoJPEG::XDualJPEG::get_ClassID(BSTR FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoJPEG, DualJPEG)

    TRY_DUAL(IID_ITurboCADFilter)
    {
        *retval = pThis->GetClassID();
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoJPEG::XDualJPEG::get_Description(BSTR FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoJPEG, DualJPEG)

    TRY_DUAL(IID_ITurboCADFilter)
    {
        *retval = pThis->GetDescription();
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoJPEG::XDualJPEG::get_Info(BSTR FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoJPEG, DualJPEG)

    TRY_DUAL(IID_ITurboCADFilter)
    {
        *retval = pThis->GetInfo();
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoJPEG::XDualJPEG::get_LastError(BSTR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoJPEG, DualJPEG)

    TRY_DUAL(IID_ITurboCADFilter)
    {
        *retval = pThis->GetLastError();
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoJPEG::XDualJPEG::CheckFlat(IDispatch* ThisFilter, BSTR FileName, long ContextFlags, VARIANT FAR* QueryString, long FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoJPEG, DualJPEG)

    TRY_DUAL(IID_ITurboCADFilter)
    {
        CString strFileName(FileName);
        *retval = pThis->CheckFlat(ThisFilter, strFileName, ContextFlags, QueryString);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoJPEG::XDualJPEG::PreviewFlat(IDispatch* ThisFilter, BSTR FileName, long ThumbWidth, long ThumbHeight, BSTR FAR* Description, VARIANT FAR* Thumbnail, long FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoJPEG, DualJPEG)

    TRY_DUAL(IID_ITurboCADFilter)
    {
        CString strFileName(FileName);
        *retval = pThis->PreviewFlat(ThisFilter, strFileName, ThumbWidth, ThumbHeight, Description, Thumbnail);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoJPEG::XDualJPEG::ReadFlat(BSTR FileName, long ContextFlags, IDispatch * Graphics, VARIANT FAR* QueryString, long FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoJPEG, DualJPEG)

    TRY_DUAL(IID_ITurboCADFilter)
    {
        CString strFileName(FileName);
        *retval = pThis->ReadFlat(strFileName, ContextFlags, Graphics, QueryString);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoJPEG::XDualJPEG::WriteFlat(BSTR FileName, long ContextFlags, IDispatch * Graphics, VARIANT FAR* QueryString, long FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoJPEG, DualJPEG)

    TRY_DUAL(IID_ITurboCADFilter)
    {
        CString strFileName(FileName);
        *retval = pThis->WriteFlat(strFileName, ContextFlags, Graphics, QueryString);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoJPEG::XDualJPEG::ReadSetup(IDispatch* ThisFilter, VARIANT_BOOL FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoJPEG, DualJPEG)

    TRY_DUAL(IID_ITurboCADFilter)
    {
        *retval = pThis->ReadSetup(ThisFilter);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoJPEG::XDualJPEG::WriteSetup(IDispatch* ThisFilter, VARIANT_BOOL FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoJPEG, DualJPEG)

    TRY_DUAL(IID_ITurboCADFilter)
    {
        *retval = pThis->WriteSetup(ThisFilter);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoJPEG::XDualJPEG::Initialize(IDispatch* ThisFilter, VARIANT_BOOL FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoJPEG, DualJPEG)

    TRY_DUAL(IID_ITurboCADFilter)
    {
        *retval = pThis->Initialize(ThisFilter);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

// Implement ISupportErrorInfo to indicate we support the
// OLE Automation error handler.
IMPLEMENT_DUAL_ERRORINFO(CAutoJPEG, IID_ITurboCADFilter)

// DUAL_SUPPORT_END


Examples - C++ JPEG Filter - AutoJPEG.h

AutoJPEG.h

C++ JPEG Filter Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// AutoJPEG.h : header file
//

#include "WSetup.h"

/////////////////////////////////////////////////////////////////////////////
// CAutoJPEG command target

class CAutoJPEG : public CCmdTarget
{
    DECLARE_DYNCREATE(CAutoJPEG)

    CAutoJPEG();           // protected constructor used by dynamic creation

// Attributes
public:
    CJPEGWriteSetup m_dlg;

// Operations
public:

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CAutoJPEG)
    public:
    virtual void OnFinalRelease();
    //}}AFX_VIRTUAL

// Implementation
protected:
    virtual ~CAutoJPEG();
    BOOL GetProfileName(IApplication* pIApp, CString& strProfileName);

    // Generated message map functions
    //{{AFX_MSG(CAutoJPEG)
        // NOTE - the ClassWizard will add and remove member functions here.
    //}}AFX_MSG

    DECLARE_MESSAGE_MAP()
    DECLARE_OLECREATE(CAutoJPEG)

    // Generated OLE dispatch map functions
    //{{AFX_DISPATCH(CAutoJPEG)
    afx_msg BSTR GetClassID();
    afx_msg BSTR GetDescription();
    afx_msg BSTR GetInfo();
    afx_msg BSTR GetLastError();
    afx_msg long CheckFlat(LPDISPATCH ThisFilter, LPCTSTR FileName, long ContextFlags, VARIANT FAR* QueryString);
    afx_msg long PreviewFlat(LPDISPATCH ThisFilter, LPCTSTR FileName, long ThumbWidth, long ThumbHeight, BSTR FAR* Description, VARIANT FAR* Thumbnail);
    afx_msg long ReadFlat(LPCTSTR FileName, long ContextFlags, LPDISPATCH Graphics, VARIANT FAR* QueryString);
    afx_msg long WriteFlat(LPCTSTR FileName, long ContextFlags, LPDISPATCH Graphics, VARIANT FAR* QueryString);
    afx_msg BOOL ReadSetup(LPDISPATCH ThisFilter);
    afx_msg BOOL WriteSetup(LPDISPATCH ThisFilter);
    afx_msg BOOL Initialize(LPDISPATCH ThisFilter);
    //}}AFX_DISPATCH
    DECLARE_DISPATCH_MAP()
    DECLARE_INTERFACE_MAP()

    // DUAL_SUPPORT_START
    //    add declaration of ISmartObjectServer implementation
    //	  You need one entry here for each entry in the
    //	  interface statement of the ODL, plus the entries for a
    //	  dispatch interface. The BEGIN_DUAL_INTERFACE_PART
    //	  macro in mfcdual.h automatically generates the IDispatch
    //	  entries for you.
    //	  Each entry with the "propput" attribute needs a function
    //    named "put_<property name>". Each entry with the "propget"
    //	  attribute needs a function named "get_<property name>".
    //	  You can pull these function prototypes from the header file
    //	  generated by MKTYPLIB.
    BEGIN_DUAL_INTERFACE_PART(DualJPEG, ITurboCADFilter)
        STDMETHOD(get_ClassID)(THIS_ BSTR FAR* retval);
        STDMETHOD(get_Description)(THIS_ BSTR FAR* retval);
        STDMETHOD(get_Info)(THIS_ BSTR FAR* retval);
        STDMETHOD(get_LastError)(THIS_ BSTR* retval);
        STDMETHOD(CheckFlat)(THIS_ IDispatch* ThisFilter, BSTR FileName, long ContextFlags, VARIANT FAR* QueryString, long FAR* retval);
        STDMETHOD(PreviewFlat)(THIS_ IDispatch* ThisFilter, BSTR FileName, long ThumbWidth, long ThumbHeight, BSTR FAR* Description, VARIANT FAR* Thumbnail, long FAR* retval);
        STDMETHOD(ReadFlat)(THIS_ BSTR FileName, long ContextFlags, IDispatch* Graphics, VARIANT FAR* QueryString, long FAR* retval);
        STDMETHOD(WriteFlat)(THIS_ BSTR FileName, long ContextFlags, IDispatch* Graphics, VARIANT FAR* QueryString, long FAR* retval);
        STDMETHOD(ReadSetup)(THIS_ IDispatch* ThisFilter, VARIANT_BOOL FAR* retval);
        STDMETHOD(WriteSetup)(THIS_ IDispatch* ThisFilter, VARIANT_BOOL FAR* retval);
        STDMETHOD(Initialize)(THIS_ IDispatch* ThisFilter, VARIANT_BOOL FAR* retval);
    END_DUAL_INTERFACE_PART(DualJPEG)

    //     add declaration of ISupportErrorInfo implementation
    //     to indicate we support the OLE Automation error object
    DECLARE_DUAL_ERRORINFO()
    // DUAL_SUPPORT_END
};

/////////////////////////////////////////////////////////////////////////////


Examples - C++ JPEG Filter - JPEG.CPP

JPEG.CPP

C++ JPEG Filter Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// JPEG.cpp : Defines the initialization routines for the DLL.
//

#include "stdafx.h"
#include "JPEG.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CJPEGApp

BEGIN_MESSAGE_MAP(CJPEGApp, CWinApp)
    //{{AFX_MSG_MAP(CJPEGApp)
        // NOTE - the ClassWizard will add and remove mapping macros here.
        //    DO NOT EDIT what you see in these blocks of generated code!
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CJPEGApp construction

// DUAL_SUPPORT_START

// Note: if you make a custom filter by copying this file, make sure to replace the following
//  GUID with a new GUID that matches the uuid statement in the library declaration in the
//  .ODL file.  This is the GUID that OLE will use to register and use the automation object's
//  type library.

// {28696022-B7E6-11D0-9B3B-444553540000}
static const GUID LIBID_JPEG =
    { 0x28696022L, 0xb7e6, 0x11d0, 0x9b, 0x3b, 0x44, 0x45, 0x53, 0x54, 0x0, 0x0 };
// DUAL_SUPPORT_END

CJPEGApp::CJPEGApp()
{
}

/////////////////////////////////////////////////////////////////////////////
// The one and only CJPEGApp object

CJPEGApp theApp;

/////////////////////////////////////////////////////////////////////////////
// CJPEGApp initialization

BOOL CJPEGApp::InitInstance()
{
    // Register all OLE server (factories) as running.  This enables the
    //  OLE libraries to create objects from other applications.
    COleObjectFactory::RegisterAll();

    // DUAL_SUPPORT_START
    //    make sure the type library is registerd. Otherwise dual interface won't work!
    //    note that we are embedding type library as a resource in this DLL.
    AfxOleRegisterTypeLib(AfxGetInstanceHandle(), LIBID_JPEG);
    // DUAL_SUPPORT_END

    return TRUE;
}

/////////////////////////////////////////////////////////////////////////////
// Special entry points required for inproc servers

STDAPI DllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID* ppv)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    return AfxDllGetClassObject(rclsid, riid, ppv);
}

STDAPI DllCanUnloadNow(void)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    return AfxDllCanUnloadNow();
}

// by exporting DllRegisterServer, you can use regsvr.exe
STDAPI DllRegisterServer(void)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    COleObjectFactory::UpdateRegistryAll();
    return S_OK;
}


Examples - C++ JPEG Filter - JPEG.H

JPEG.H

C++ JPEG Filter Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// JPEG.h : main header file for the JPEG DLL
//

#ifndef __AFXWIN_H__
    #error include 'stdafx.h' before including this file for PCH
#endif

#include "resource.h"		// main symbols

/////////////////////////////////////////////////////////////////////////////
// CJPEGApp
// See JPEG.cpp for the implementation of this class
//

class CJPEGApp : public CWinApp
{
public:
    CJPEGApp();

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CJPEGApp)
    public:
    virtual BOOL InitInstance();
    //}}AFX_VIRTUAL

    //{{AFX_MSG(CJPEGApp)
        // NOTE - the ClassWizard will add and remove member functions here.
        //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

/////////////////////////////////////////////////////////////////////////////


Examples - C++ JPEG Filter - Mfcdual.cpp

Mfcdual.cpp

C++ JPEG Filter Example

// mfcdual.cpp: Helpful functions for adding dual interface support to
//		        MFC applications

// This is a part of the Microsoft Foundation Classes C++ library.
// Copyright (C) 1992-1996 Microsoft Corporation
// All rights reserved.
//
// This source code is only intended as a supplement to the
// Microsoft Foundation Classes Reference and related
// electronic documentation provided with the library.
// See these sources for detailed information regarding the
// Microsoft Foundation Classes product.

#include "stdafx.h"

#include <afxpriv.h>

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// DualHandleException

HRESULT DualHandleException(REFIID riidSource, const CException* pAnyException)
{
    USES_CONVERSION;

    ASSERT_VALID(pAnyException);

    TRACE0("DualHandleException called\n");

    // Set ErrInfo object so that VTLB binding container
    // applications can get rich error information.
    ICreateErrorInfo* pcerrinfo;
    HRESULT hr = CreateErrorInfo(&pcerrinfo);
    if (SUCCEEDED(hr))
    {
        TCHAR   szDescription[256];
        LPCTSTR pszDescription = szDescription;
        GUID    guid = GUID_NULL;
        DWORD   dwHelpContext = 0;
        BSTR    bstrHelpFile = NULL;
        BSTR    bstrSource = NULL;
        if (pAnyException->IsKindOf(RUNTIME_CLASS(COleDispatchException)))
        {
            // specific IDispatch style exception
            COleDispatchException* e = (COleDispatchException*)pAnyException;

            guid = riidSource;
            hr = MAKE_HRESULT(SEVERITY_ERROR, FACILITY_ITF,
                              (e->m_wCode + 0x200));

            pszDescription = e->m_strDescription;
            dwHelpContext = e->m_dwHelpContext;

            // propagate source and help file if present
            // call ::SysAllocString directly so no further exceptions are thrown
            if (!e->m_strHelpFile.IsEmpty())
                bstrHelpFile = ::SysAllocString(T2COLE(e->m_strHelpFile));
            if (!e->m_strSource.IsEmpty())
                bstrSource = ::SysAllocString(T2COLE(e->m_strSource));

        }
        else if (pAnyException->IsKindOf(RUNTIME_CLASS(CMemoryException)))
        {
            // failed memory allocation
            AfxLoadString(AFX_IDP_FAILED_MEMORY_ALLOC, szDescription);
            hr = E_OUTOFMEMORY;
        }
        else
        {
            // other unknown/uncommon error
            AfxLoadString(AFX_IDP_INTERNAL_FAILURE, szDescription);
            hr = E_UNEXPECTED;
        }

        if (bstrHelpFile == NULL && dwHelpContext != 0)
            bstrHelpFile = ::SysAllocString(T2COLE(AfxGetApp()->m_pszHelpFilePath));

        if (bstrSource == NULL)
            bstrSource = ::SysAllocString(T2COLE(AfxGetAppName()));

        // Set up ErrInfo object
        pcerrinfo->SetGUID(guid);
        pcerrinfo->SetDescription(::SysAllocString(T2COLE(pszDescription)));
        pcerrinfo->SetHelpContext(dwHelpContext);
        pcerrinfo->SetHelpFile(bstrHelpFile);
        pcerrinfo->SetSource(bstrSource);

        TRACE("\tSource = %ws\n", bstrSource);
        TRACE("\tDescription = %s\n", pszDescription);
        TRACE("\tHelpContext = %lx\n", dwHelpContext);
        TRACE("\tHelpFile = %ws\n", bstrHelpFile);

        // Set the ErrInfo object for the current thread
        IErrorInfo* perrinfo;
        if (SUCCEEDED(pcerrinfo->QueryInterface(IID_IErrorInfo, (LPVOID*)&perrinfo)))
        {
            SetErrorInfo(0, perrinfo);
            perrinfo->Release();
        }

        pcerrinfo->Release();
    }

    TRACE("DualHandleException returning HRESULT %lx\n", hr);

    return hr;
}


Examples - C++ JPEG Filter - Mfcdual.h

Mfcdual.h

C++ JPEG Filter Example

// mfcdual.h: Helpful macros for adding dual interface support to
//			  MFC applications

// This is a part of the Microsoft Foundation Classes C++ library.
// Copyright (C) 1992-1996 Microsoft Corporation
// All rights reserved.
//
// This source code is only intended as a supplement to the
// Microsoft Foundation Classes Reference and related
// electronic documentation provided with the library.
// See these sources for detailed information regarding the
// Microsoft Foundation Classes product.

/////////////////////////////////////////////////////////////////////
// BEGIN_DUAL_INTERFACE_PART is just like BEGIN_INTERFACE_PART,
// except that it also adds the IDispatch methods to your class
// declaration.
#define BEGIN_DUAL_INTERFACE_PART(localClass, baseClass) \
    BEGIN_INTERFACE_PART(localClass, baseClass) \
       STDMETHOD(GetTypeInfoCount)(UINT FAR* pctinfo); \
       STDMETHOD(GetTypeInfo)(UINT itinfo, LCID lcid, ITypeInfo FAR* FAR* pptinfo); \
       STDMETHOD(GetIDsOfNames)(REFIID riid, OLECHAR FAR* FAR* rgszNames, UINT cNames, LCID lcid, DISPID FAR* rgdispid); \
       STDMETHOD(Invoke)(DISPID dispidMember, REFIID riid, LCID lcid, WORD wFlags, DISPPARAMS FAR* pdispparams, VARIANT FAR* pvarResult, EXCEPINFO FAR* pexcepinfo, UINT FAR* puArgErr); \

/////////////////////////////////////////////////////////////////////
// END_DUAL_INTERFACE_PART is just like END_INTERFACE_PART. It
// is only added for symmetry...
#define END_DUAL_INTERFACE_PART(localClass) \
    END_INTERFACE_PART(localClass) \

/////////////////////////////////////////////////////////////////////
// DELEGATE_DUAL_INTERFACE expands to define the standard IDispatch
// methods for a dual interface, delegating back to the default
// MFC implementation
#define DELEGATE_DUAL_INTERFACE(objectClass, dualClass) \
    STDMETHODIMP_(ULONG) objectClass::X##dualClass::AddRef() \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        return pThis->ExternalAddRef(); \
    } \
    STDMETHODIMP_(ULONG) objectClass::X##dualClass::Release() \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        return pThis->ExternalRelease(); \
    } \
    STDMETHODIMP objectClass::X##dualClass::QueryInterface( \
        REFIID iid, LPVOID* ppvObj) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        return pThis->ExternalQueryInterface(&iid, ppvObj); \
    } \
    STDMETHODIMP objectClass::X##dualClass::GetTypeInfoCount( \
        UINT FAR* pctinfo) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->GetTypeInfoCount(pctinfo); \
    } \
    STDMETHODIMP objectClass::X##dualClass::GetTypeInfo( \
        UINT itinfo, LCID lcid, ITypeInfo FAR* FAR* pptinfo) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->GetTypeInfo(itinfo, lcid, pptinfo); \
    } \
    STDMETHODIMP objectClass::X##dualClass::GetIDsOfNames( \
        REFIID riid, OLECHAR FAR* FAR* rgszNames, UINT cNames, \
        LCID lcid, DISPID FAR* rgdispid) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->GetIDsOfNames(riid, rgszNames, cNames, \
                                         lcid, rgdispid); \
    } \
    STDMETHODIMP objectClass::X##dualClass::Invoke( \
        DISPID dispidMember, REFIID riid, LCID lcid, WORD wFlags, \
        DISPPARAMS FAR* pdispparams, VARIANT FAR* pvarResult, \
        EXCEPINFO FAR* pexcepinfo, UINT FAR* puArgErr) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->Invoke(dispidMember, riid, lcid, \
                                  wFlags, pdispparams, pvarResult, \
                                  pexcepinfo, puArgErr); \
    } \

/////////////////////////////////////////////////////////////////////
// TRY_DUAL and CATCH_ALL_DUAL are used to provide exception handling
// for your dual interface methods. CATCH_ALL_DUAL takes care of
// returning the appropriate error code.

#define TRY_DUAL(iidSource) \
    HRESULT _hr = S_OK; \
    REFIID  _riidSource = iidSource; \
    TRY \

#define CATCH_ALL_DUAL \
    CATCH(COleException, e) \
    { \
        _hr = e->m_sc; \
    } \
    AND_CATCH_ALL(e) \
    { \
        AFX_MANAGE_STATE(pThis->m_pModuleState); \
        _hr = DualHandleException(_riidSource, e); \
    } \
    END_CATCH_ALL \
    return _hr; \

/////////////////////////////////////////////////////////////////////
// DualHandleException is a helper function used to set the system's
// error object, so that container applications that call through
// VTBLs can retrieve rich error information
HRESULT DualHandleException(REFIID riidSource, const CException* pAnyException);

/////////////////////////////////////////////////////////////////////
// DECLARE_DUAL_ERRORINFO expands to declare the ISupportErrorInfo
// support class. It works together with DUAL_ERRORINFO_PART and
// IMPLEMENT_DUAL_ERRORINFO defined below.
#define DECLARE_DUAL_ERRORINFO() \
    BEGIN_INTERFACE_PART(SupportErrorInfo, ISupportErrorInfo) \
        STDMETHOD(InterfaceSupportsErrorInfo)(THIS_ REFIID riid); \
    END_INTERFACE_PART(SupportErrorInfo) \

/////////////////////////////////////////////////////////////////////
// DUAL_ERRORINFO_PART adds the appropriate entry to the interface map
// for ISupportErrorInfo, if you used DECLARE_DUAL_ERRORINFO.
#define DUAL_ERRORINFO_PART(objectClass) \
    INTERFACE_PART(objectClass, IID_ISupportErrorInfo, SupportErrorInfo) \

/////////////////////////////////////////////////////////////////////
// IMPLEMENT_DUAL_ERRORINFO expands to an implementation of
// ISupportErrorInfo which matches the declaration in
// DECLARE_DUAL_ERRORINFO.
#define IMPLEMENT_DUAL_ERRORINFO(objectClass, riidSource) \
    STDMETHODIMP_(ULONG) objectClass::XSupportErrorInfo::AddRef() \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return pThis->ExternalAddRef(); \
    } \
    STDMETHODIMP_(ULONG) objectClass::XSupportErrorInfo::Release() \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return pThis->ExternalRelease(); \
    } \
    STDMETHODIMP objectClass::XSupportErrorInfo::QueryInterface( \
        REFIID iid, LPVOID* ppvObj) \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return pThis->ExternalQueryInterface(&iid, ppvObj); \
    } \
    STDMETHODIMP objectClass::XSupportErrorInfo::InterfaceSupportsErrorInfo( \
        REFIID iid) \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return (iid == riidSource) ? S_OK : S_FALSE; \
    }

/////////////////////////////////////////////////////////////////////


Examples - C++ JPEG Filter - WSetup.cpp

WSetup.cpp

C++ JPEG Filter Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// WSetup.cpp : implementation file
//

#include "stdafx.h"
#include "JPEG.h"
#include "WSetup.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CJPEGWriteSetup dialog

// This is a trivial example of a settings UI dialog.  We store the width and height
// of the desired JPEG image in two data members, that we access in our automation object.

const int nDefaultHeight = 128;
const int nDefaultWidth = 128;

CJPEGWriteSetup::CJPEGWriteSetup(CWnd* pParent /*=NULL*/)
    : CDialog(CJPEGWriteSetup::IDD, pParent)
{
    //{{AFX_DATA_INIT(CJPEGWriteSetup)
    m_nHeight = nDefaultHeight;
    m_nWidth = nDefaultWidth;
    //}}AFX_DATA_INIT
}

void CJPEGWriteSetup::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CJPEGWriteSetup)
    DDX_Text(pDX, IDC_JPEG_HEIGHT, m_nHeight);
    DDV_MinMaxUInt(pDX, m_nHeight, 1, 1024);
    DDX_Text(pDX, IDC_JPEG_WIDTH, m_nWidth);
    DDV_MinMaxUInt(pDX, m_nWidth, 1, 1024);
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CJPEGWriteSetup, CDialog)
    //{{AFX_MSG_MAP(CJPEGWriteSetup)
        // NOTE: the ClassWizard will add message map macros here
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

static const TCHAR szJPEGFilter[] = _T("JPEG_Filter");
static const TCHAR szWidth[] = _T("Height");
static const TCHAR szHeight[] = _T("Width");

// Retrieve settings from the specified INI file.
// We use a (hopefully) unique section name to store our data.

void CJPEGWriteSetup::FromProfile(LPCTSTR szProfile)
{
    m_nWidth = ::GetPrivateProfileInt(szJPEGFilter, szWidth, nDefaultWidth, szProfile);
    m_nHeight = ::GetPrivateProfileInt(szJPEGFilter, szHeight, nDefaultHeight, szProfile);
}

// Save settings to the specified INI file.
// We use a (hopefully) unique section name to store our data.

void CJPEGWriteSetup::ToProfile(LPCTSTR szProfile)
{
    TCHAR szBuf[32];
    _itot(m_nWidth, szBuf, 10);
    ::WritePrivateProfileString(szJPEGFilter, szWidth, szBuf, szProfile);
    _itot(m_nHeight, szBuf, 10);
    ::WritePrivateProfileString(szJPEGFilter, szHeight, szBuf, szProfile);
}

/////////////////////////////////////////////////////////////////////////////
// CJPEGWriteSetup message handlers


Examples - C++ JPEG Filter - WSetup.h

WSetup.h

C++ JPEG Filter Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// WSetup.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CJPEGWriteSetup dialog

class CJPEGWriteSetup : public CDialog
{
// Construction
public:
    CJPEGWriteSetup(CWnd* pParent = NULL);   // standard constructor

// Dialog Data
    //{{AFX_DATA(CJPEGWriteSetup)
    enum { IDD = IDD_JPEG_WRITE_SETUP };
    UINT	m_nHeight;
    UINT	m_nWidth;
    //}}AFX_DATA

// Operations
public:
    void FromProfile(LPCTSTR szProfile);
    void ToProfile(LPCTSTR szProfile);

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CJPEGWriteSetup)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:

    // Generated message map functions
    //{{AFX_MSG(CJPEGWriteSetup)
        // NOTE: the ClassWizard will add member functions here
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};


Examples - C++ Palette - CustomPalette.cpp

CustomPalette.cpp

C++ Palette Example

// CustomPalette.cpp : Defines the initialization routines for the DLL.
//

#include "stdafx.h"
#include "CustomPalette.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

//
//	Note!
//
//		If this DLL is dynamically linked against the MFC
//		DLLs, any functions exported from this DLL which
//		call into MFC must have the AFX_MANAGE_STATE macro
//		added at the very beginning of the function.
//
//		For example:
//
//		extern "C" BOOL PASCAL EXPORT ExportedFunction()
//		{
//			AFX_MANAGE_STATE(AfxGetStaticModuleState());
//			// normal function body here
//		}
//
//		It is very important that this macro appear in each
//		function, prior to any calls into MFC.  This means that
//		it must appear as the first statement within the
//		function, even before any object variable declarations
//		as their constructors may generate calls into the MFC
//		DLL.
//
//		Please see MFC Technical Notes 33 and 58 for additional
//		details.
//

/////////////////////////////////////////////////////////////////////////////
// CCustomPaletteApp

BEGIN_MESSAGE_MAP(CCustomPaletteApp, CWinApp)
    //{{AFX_MSG_MAP(CCustomPaletteApp)
        // NOTE - the ClassWizard will add and remove mapping macros here.
        //    DO NOT EDIT what you see in these blocks of generated code!
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CCustomPaletteApp construction

CCustomPaletteApp::CCustomPaletteApp()
{
    // TODO: add construction code here,
    // Place all significant initialization in InitInstance
}

/////////////////////////////////////////////////////////////////////////////
// The one and only CCustomPaletteApp object

CCustomPaletteApp theApp;

/////////////////////////////////////////////////////////////////////////////
// CCustomPaletteApp initialization

BOOL CCustomPaletteApp::InitInstance()
{
    // Register all OLE server (factories) as running.  This enables the
    //  OLE libraries to create objects from other applications.
    COleObjectFactory::RegisterAll();

    return TRUE;
}

/////////////////////////////////////////////////////////////////////////////
// Special entry points required for inproc servers

STDAPI DllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID* ppv)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    return AfxDllGetClassObject(rclsid, riid, ppv);
}

STDAPI DllCanUnloadNow(void)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    return AfxDllCanUnloadNow();
}

// by exporting DllRegisterServer, you can use regsvr.exe
STDAPI DllRegisterServer(void)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    COleObjectFactory::UpdateRegistryAll();
    return S_OK;
}
HINSTANCE MyGetResourceHandle()
{
    return theApp.m_hInstance;
}


Examples - C++ Palette - CustomPalette.h

CustomPalette.h

C++ Palette Example

// CustomPalette.h : main header file for the CUSTOMPALETTE DLL
//

#if !defined(AFX_CUSTOMPALETTE_H__93B6FFAE_3A35_45BD_90F7_FD10006CA3C8__INCLUDED_)
#define AFX_CUSTOMPALETTE_H__93B6FFAE_3A35_45BD_90F7_FD10006CA3C8__INCLUDED_

#if _MSC_VER > 1000
#pragma once
#endif // _MSC_VER > 1000

#ifndef __AFXWIN_H__
    #error include 'stdafx.h' before including this file for PCH
#endif

#include "resource.h"		// main symbols

/////////////////////////////////////////////////////////////////////////////
// CCustomPaletteApp
// See CustomPalette.cpp for the implementation of this class
//

class CCustomPaletteApp : public CWinApp
{
public:
    CCustomPaletteApp();

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CCustomPaletteApp)
    public:
    virtual BOOL InitInstance();
    //}}AFX_VIRTUAL

    //{{AFX_MSG(CCustomPaletteApp)
        // NOTE - the ClassWizard will add and remove member functions here.
        //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

/////////////////////////////////////////////////////////////////////////////

//{{AFX_INSERT_LOCATION}}
// Microsoft Visual C++ will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_CUSTOMPALETTE_H__93B6FFAE_3A35_45BD_90F7_FD10006CA3C8__INCLUDED_)


Examples - C++ Palette - PalDlg.cpp

PalDlg.cpp

C++ Palette Example

// PalDlg.cpp : implementation file
//

#include "stdafx.h"
#include "CustomPalette.h"
#include "PalDlg.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CPalDlg dialog

CPalDlg::CPalDlg(CWnd* pParent /*=NULL*/)
    : CDialog(CPalDlg::IDD, pParent)
{
    //{{AFX_DATA_INIT(CPalDlg)
        // NOTE: the ClassWizard will add member initialization here
    //}}AFX_DATA_INIT
}

IMPLEMENT_DYNAMIC(CPalDlg, CDialog)

void CPalDlg::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CPalDlg)
        // NOTE: the ClassWizard will add DDX and DDV calls here
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CPalDlg, CDialog)
    //{{AFX_MSG_MAP(CPalDlg)
    ON_BN_CLICKED(IDC_TEST, OnTest)
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CPalDlg message handlers

IApplication* GetTcApp()
{
 IApplication *pIApplication = NULL;

 BOOL bCreateInstance = TRUE;
 IUnknown* pUnk = NULL;
 HRESULT hRes = ::GetActiveObject(CLSID_Application, NULL, &pUnk);
 if (pUnk == NULL)
  return NULL;

 hRes = pUnk->QueryInterface(IID_IApplication, (void**)&pIApplication);
 pUnk->Release();
 if (FAILED(hRes))
 {
  return NULL;
 }

 return pIApplication;
}

void CPalDlg::OnTest()
{
    // TODO: Add your control notification handler code here
    HRESULT hRes = E_FAIL;
    Drawings* pDrs = NULL;
    long lDrawingsCount = 0;
    CString strTmp;
    strTmp = "There are  drawings loaded";

    IApplication* pIApp = GetTcApp();
    if(pIApp !=NULL)
    {
        hRes = pIApp->get_Drawings(&pDrs);
        if(SUCCEEDED(hRes))
        {
            hRes = pDrs->get_Count(&lDrawingsCount);

        }
    }
    char v[10];
    memset(v, 0, 10);
//	lPsscount++;
    _ltoa(lDrawingsCount,v, 10);
    strTmp.Insert (10,v);
    //strTmp.Format("There are %l drawings loaded ",lDrawingsCount);
//	AfxMessageBox(strTmp);
    MessageBox(strTmp, "Custom docking palette");
    RELEASE(pDrs);
    RELEASE(pIApp);
}


Examples - C++ Palette - PalDlg.h

PalDlg.h

C++ Palette Example

#if !defined(AFX_PALDLG_H__180C1E4C_6BF0_4D0B_AE71_CBE90BA8D14F__INCLUDED_)
#define AFX_PALDLG_H__180C1E4C_6BF0_4D0B_AE71_CBE90BA8D14F__INCLUDED_

#if _MSC_VER > 1000
#pragma once
#endif // _MSC_VER > 1000
// PalDlg.h : header file
//
#include "resource.h"

/////////////////////////////////////////////////////////////////////////////
// CPalDlg dialog

class CPalDlg : public CDialog
{
    DECLARE_DYNAMIC(CPalDlg)

// Construction
public:
    CPalDlg(CWnd* pParent = NULL);   // standard constructor

// Dialog Data
    //{{AFX_DATA(CPalDlg)
    enum { IDD = IDD_PALDLG };
        // NOTE: the ClassWizard will add data members here
    //}}AFX_DATA

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CPalDlg)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:

    // Generated message map functions
    //{{AFX_MSG(CPalDlg)
    afx_msg void OnTest();
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

//{{AFX_INSERT_LOCATION}}
// Microsoft Visual C++ will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_PALDLG_H__180C1E4C_6BF0_4D0B_AE71_CBE90BA8D14F__INCLUDED_)


Examples - C++ Palette - pltapi.cpp

pltapi.cpp

C++ Palette Example

#include "stdafx.h"

#include "PalDlg.h"

#include "resource.h"

UINT WINAPI PltGetHelpID()
{
    return IDD_PALDLG;
}

BSTR		WINAPI PltGetDescription()
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());

    CString cstrDesc;
    cstrDesc.LoadString(IDS_DESCRIPTION);

    return cstrDesc.AllocSysString();
}

BSTR		WINAPI PltGetName()
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());

    CString cstrName;
    cstrName.LoadString(IDS_NAME);

    return cstrName.AllocSysString();
}

IDispatch*	WINAPI PltGetPicture(BOOL bLargeButton, BOOL bMonochrome)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());

    LPTSTR IDB = 0;

    if (bLargeButton)
    {
        IDB = MAKEINTRESOURCE(IDB_PLT32);
    }
    else
    {
        IDB = MAKEINTRESOURCE(IDB_PLT16);
    }

    IDispatch *pIPictDisp = NULL;

    HBITMAP hbmpPal = ::LoadBitmap(AfxGetResourceHandle(), IDB);

    PICTDESC pict;
    pict.cbSizeofstruct = sizeof(pict);
    pict.picType = PICTYPE_BITMAP;
    pict.bmp.hbitmap = hbmpPal;
    pict.bmp.hpal = NULL;

    VERIFY(SUCCEEDED(OleCreatePictureIndirect(&pict, IID_IDispatch, TRUE, (void**)&pIPictDisp)));
/*
#ifdef _DEBUG
    IPicture* pIPict = NULL;
    OLE_YSIZE_HIMETRIC height = 0;
    OLE_XSIZE_HIMETRIC width = 0;
    pIPictDisp->QueryInterface(IID_IPicture, (void**)&pIPict);
    if (pIPict != NULL)
    {
        pIPict->get_Height(&height);
        pIPict->get_Width(&width);
        pIPict->Release();
    }
#endif
*/
    return pIPictDisp;
}

HINSTANCE MyGetResourceHandle();

HWND		WINAPI PltCreateWindow(HWND hwndParent, long nID)
{
//	AFX_MANAGE_STATE(AfxGetStaticModuleState());

    HINSTANCE hResOld = AfxGetResourceHandle();
    AfxSetResourceHandle(MyGetResourceHandle());

    HWND hwndPal = NULL;

    CPalDlg *pDlg = new CPalDlg;
    CWnd *pParentWnd = CWnd::FromHandle(hwndParent);

    if (pDlg->Create(IDD_PALDLG, pParentWnd))
        hwndPal = pDlg->GetSafeHwnd();

    AfxSetResourceHandle(hResOld);

    return hwndPal;
}


Examples - C++ Rounded Rectangle Regen - AUTORECT.CPP

AUTORECT.CPP

C++ Rounded Rectangle Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// AutoRect.cpp : implementation file
//

#include "stdafx.h"
#include "RRect.h"
#include "AutoRect.h"  // This class
#include "RectPage.h"  // Property page class
#include "GxIntf.h"   // TurboCAD interfaces (forward declarations)
#include "Imsigx.h"   // TurboCAD interfaces
#include <math.h>

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

// Standard variants
COleVariant t(-1L, VT_BOOL);
COleVariant f(0L, VT_BOOL);
COleVariant z(0.0);
COleVariant missing((long)DISP_E_PARAMNOTFOUND, VT_ERROR);
const double PI = 3.14159265;

/////////////////////////////////////////////////////////////////////////////
// CAutoRect

const IID IID_IGraphic =
    {0x6A481109,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

IMPLEMENT_DYNCREATE(CAutoRect, CCmdTarget)

CAutoRect::CAutoRect() :
    m_pRectPage(NULL)
{
    EnableAutomation();

    // To keep the application running as long as an OLE automation
    //	object is active, the constructor calls AfxOleLockApp.

    AfxOleLockApp();
}

CAutoRect::~CAutoRect()
{
    // To terminate the application when all objects created with
    // 	with OLE automation, the destructor calls AfxOleUnlockApp.

    AfxOleUnlockApp();
}

void CAutoRect::OnFinalRelease()
{
    // When the last reference for an automation object is released
    // OnFinalRelease is called.  The base class will automatically
    // deletes the object.  Add additional cleanup required for your
    // object before calling the base class.

    CCmdTarget::OnFinalRelease();
}

BEGIN_MESSAGE_MAP(CAutoRect, CCmdTarget)
    //{{AFX_MSG_MAP(CAutoRect)
        // NOTE - the ClassWizard will add and remove mapping macros here.
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

BEGIN_DISPATCH_MAP(CAutoRect, CCmdTarget)
    //{{AFX_DISPATCH_MAP(CAutoRect)
    DISP_PROPERTY_EX(CAutoRect, "ClassID", GetClassID, SetNotSupported, VT_BSTR)
    DISP_PROPERTY_EX(CAutoRect, "Description", GetDescription, SetNotSupported, VT_BSTR)
    DISP_FUNCTION(CAutoRect, "GetPropertyInfo", GetPropertyInfo, VT_I4, VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT)
    DISP_FUNCTION(CAutoRect, "GetPageInfo", GetPageInfo, VT_I4, VTS_DISPATCH VTS_PI4 VTS_PVARIANT)
    DISP_FUNCTION(CAutoRect, "GetWizardInfo", GetWizardInfo, VT_I4, VTS_PVARIANT)
    DISP_FUNCTION(CAutoRect, "GetEnumNames", GetEnumNames, VT_I4, VTS_I4 VTS_PVARIANT VTS_PVARIANT)
    DISP_FUNCTION(CAutoRect, "PageControls", PageControls, VT_BOOL, VTS_DISPATCH VTS_DISPATCH VTS_I4 VTS_BOOL)
    DISP_FUNCTION(CAutoRect, "PageDone", PageDone, VT_EMPTY, VTS_DISPATCH VTS_PVARIANT)
    DISP_FUNCTION(CAutoRect, "PropertyPages", PropertyPages, VT_BOOL, VTS_DISPATCH VTS_PVARIANT)
    DISP_FUNCTION(CAutoRect, "Wizard", Wizard, VT_BOOL, VTS_DISPATCH VTS_PVARIANT)
    DISP_FUNCTION(CAutoRect, "OnGeometryChanged", OnGeometryChanged, VT_EMPTY, VTS_DISPATCH VTS_I4 VTS_PVARIANT VTS_PVARIANT)
    DISP_FUNCTION(CAutoRect, "OnGeometryChanging", OnGeometryChanging, VT_BOOL, VTS_DISPATCH VTS_I4 VTS_PVARIANT VTS_PVARIANT)
    DISP_FUNCTION(CAutoRect, "OnNewGraphic", OnNewGraphic, VT_BOOL, VTS_DISPATCH VTS_BOOL)
    DISP_FUNCTION(CAutoRect, "OnCopyGraphic", OnCopyGraphic, VT_BOOL, VTS_DISPATCH VTS_DISPATCH)
    DISP_FUNCTION(CAutoRect, "OnPropertyChanged", OnPropertyChanged, VT_EMPTY, VTS_DISPATCH VTS_I4 VTS_PVARIANT VTS_PVARIANT)
    DISP_FUNCTION(CAutoRect, "OnPropertyChanging", OnPropertyChanging, VT_BOOL, VTS_DISPATCH VTS_I4 VTS_PVARIANT VTS_PVARIANT)
    DISP_FUNCTION(CAutoRect, "OnPropertyGet", OnPropertyGet, VT_EMPTY, VTS_DISPATCH VTS_I4)
    DISP_FUNCTION(CAutoRect, "Draw", Draw, VT_BOOL, VTS_DISPATCH VTS_DISPATCH VTS_PVARIANT)
    DISP_FUNCTION(CAutoRect, "Regen", Regen, VT_EMPTY, VTS_DISPATCH)
    DISP_FUNCTION(CAutoRect, "Initialize", Initialize, VT_BOOL, VTS_DISPATCH)
    //}}AFX_DISPATCH_MAP
END_DISPATCH_MAP()

// Note: we add support for IID_ISmartObjectServer to support typesafe binding
//  from VBA.  This IID must match the GUID that is attached to the
//  dispinterface in the .ODL file.

// {6A481303-E531-11CF-A115-00A024158DAF}
static const IID IID_ISmartObjectServer =
{0x6A481303,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

BEGIN_INTERFACE_MAP(CAutoRect, CCmdTarget)
    INTERFACE_PART(CAutoRect, IID_ISmartObjectServer, Dispatch)
END_INTERFACE_MAP()

// {7724BB46-B671-11D0-9B3B-444553540000}
//IMPLEMENT_OLECREATE(CAutoRect, "RRect.Rectangle", 0x7724bb46, 0xb671, 0x11d0, 0x9b, 0x3b, 0x44, 0x45, 0x53, 0x54, 0x0, 0x0);
IMPLEMENT_OLECREATE(CAutoRect, "RRect.Rectangle", 0x7724bb36, 0xb671, 0x11d0, 0x9b, 0x3b, 0x44, 0x45, 0x53, 0x54, 0x0, 0x0);//# Non-localizable string#

/////////////////////////////////////////////////////////////////////////////
// CAutoRect message handlers

BSTR CAutoRect::GetClassID()
{
    // Convert our GUID (see IMPLEMENT_OLECREATE macro) to a string
    LPOLESTR olestr;
    HRESULT hRes = ::StringFromCLSID(guid, &olestr);
    if (FAILED(hRes))
        return NULL;

    BSTR bstr = ::SysAllocString(olestr);
    CoTaskMemFree(olestr);
    return bstr;
}

BSTR CAutoRect::GetDescription()
{
    // Get the description from the resource
    CString strResult;
    strResult.LoadString(IDS_AUTORECT_DESCRIPTION);

    return strResult.AllocSysString();
}

const long VT_INTEGER_ENUM = VT_I2 + 100;
const long VT_LONG_ENUM = VT_I4 + 100;
const long VT_STRING_ENUM = VT_BSTR + 100;

const long GF_COSMETIC = 128;

enum StockPages {
    PP_STOCK_PEN = 1,
    PP_STOCK_BRUSH = 2,
    PP_STOCK_TEXT = 4,
    PP_STOCK_INSERT = 8,
    PP_STOCK_VIEWPORT = 16,
    PP_STOCK_AUTO = 32
};

const long nProperties = 1;

enum PropertyIDs
{
   idRoundness = 1,
};

long CAutoRect::GetPropertyInfo(VARIANT FAR* Names, VARIANT FAR* Types, VARIANT FAR* IDs, VARIANT FAR* Defaults)
{
     ASSERT(Names->vt == VT_ARRAY|VT_BSTR);
    ASSERT(Types->vt == VT_ARRAY|VT_I4);
    ASSERT(IDs->vt == VT_ARRAY|VT_I4);
    ASSERT(Defaults->vt == VT_ARRAY|VT_VARIANT);

     SAFEARRAYBOUND bound = { nProperties, 0 };
    if (FAILED(::SafeArrayRedim(Names->parray, &bound)))
        return 0;
    if (FAILED(::SafeArrayRedim(Types->parray, &bound)))
        return 0;
    if (FAILED(::SafeArrayRedim(IDs->parray, &bound)))
        return 0;
    if (FAILED(::SafeArrayRedim(Defaults->parray, &bound)))
        return 0;

    BSTR* rgNames;
    long* rgTypes;
    long* rgIDs;
    VARIANT* rgDefaults;
    long lReturn = 0;
    if (SUCCEEDED(::SafeArrayAccessData(Names->parray, (void**)&rgNames)))
    {
        if (SUCCEEDED(::SafeArrayAccessData(Types->parray, (void**)&rgTypes)))
        {
            if (SUCCEEDED(::SafeArrayAccessData(IDs->parray, (void**)&rgIDs)))
            {
                if (SUCCEEDED(::SafeArrayAccessData(Defaults->parray, (void**)&rgDefaults)))
                {
                    CString strStr;
                    strStr.LoadString(IDS_STRING3);
                    //rgNames[0] = ::SysAllocString(OLESTR("Roundness"));//# Localizable string#
                    rgNames[0] = ::SysAllocString(strStr.AllocSysString());
                    rgTypes[0] = VT_R8;
                    rgIDs[0] = idRoundness;
                    rgDefaults[0].vt = VT_R8;
                    rgDefaults[0].dblVal = 50.0;

                    ::SafeArrayUnaccessData(Defaults->parray);
                    lReturn = nProperties;
                }
                ::SafeArrayUnaccessData(IDs->parray);
            }
            ::SafeArrayUnaccessData(Types->parray);
        }
        ::SafeArrayUnaccessData(Names->parray);
    }
    return lReturn;
}

long CAutoRect::GetPageInfo(LPDISPATCH /*AGraphic*/, long* StockPages, VARIANT FAR* Names)
{
    ASSERT(StockPages != NULL);
     ASSERT(Names->vt == VT_ARRAY|VT_BSTR);

    // Request pen page and auto page
    *StockPages = PP_STOCK_PEN | PP_STOCK_AUTO;

     SAFEARRAYBOUND bound = { 1, 0 };
    if (FAILED(::SafeArrayRedim(Names->parray, &bound)))
        return 0;

    CString strCaption;
    strCaption.LoadString(IDS_AUTORECT_CAPTION);
    BSTR bstrCaption = strCaption.AllocSysString();

    long lIndex = 0;
    if (FAILED(SafeArrayPutElement(Names->parray, &lIndex, (void*)bstrCaption)))
    {
        ::SysFreeString(bstrCaption);
        return 0;
    }
    return 1;
}

long CAutoRect::GetWizardInfo(VARIANT FAR* Names)
{
    // No wizards, nothing to do
    return 0;
}

long CAutoRect::GetEnumNames(long PropID, VARIANT FAR* Names, VARIANT FAR* Values)
{
    // Should never be called!
    return 0;
}

double GetRoundness(IGraphic* pIGraphic)
{
    double roundness = 50.0;
    Properties* pProps = NULL;
    Property* pProp;
    COleVariant varIndex, varValue;
    if (SUCCEEDED(pIGraphic->get_Properties(&pProps)))
    {
        //varIndex = "Roundness";//# Localizable string#
        CString strStr;
        strStr.LoadString(IDS_STRING3);
        varIndex = LPCTSTR(strStr);
        if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
        {
            if (SUCCEEDED(pProp->get_Value(0, &varValue)) &&
                varValue.vt == VT_R8)
            {
                roundness = varValue.dblVal;
            }
            pProp->Release();
        }
        pProps->Release();
    }
    return roundness;
}

void SetRoundness(IGraphic* pIGraphic, double roundness)
{
    Properties* pProps = NULL;
    Property* pProp;
    COleVariant varIndex;
    if (SUCCEEDED(pIGraphic->get_Properties(&pProps)))
    {
        //varIndex = "Roundness";//# Localizable string#
        CString strStr;
        strStr.LoadString(IDS_STRING3);
        varIndex = LPCTSTR(strStr);
        if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
        {
            COleVariant varValue;
            varValue.vt = VT_R8;
            varValue.dblVal = roundness;
            pProp->put_Value(0, &varValue);
            pProp->Release();
        }
        pProps->Release();
    }
}

BOOL CAutoRect::PageControls(LPDISPATCH ThisRegenMethod, LPDISPATCH AGraphic, long PageNumber, BOOL SaveProperties)
{
    IGraphic* pIGraphic = NULL;
    if (FAILED(AGraphic->QueryInterface(IID_IGraphic, (void**)&pIGraphic)))
        return FALSE;

    BOOL bReturn = FALSE;
    Properties* pProps = NULL;
    Property* pProp;
    COleVariant varIndex, varValue;
    if (SUCCEEDED(pIGraphic->get_Properties(&pProps)))
    {
        if (SaveProperties)
        {
            if (m_pRectPage != NULL)
            {
                // Note: the following can fail (for non-rounded rect graphics)
                //varIndex = "Roundness";//# Localizable string#
                CString strStr;
                strStr.LoadString(IDS_STRING3);
                varIndex = LPCTSTR(strStr);
                if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
                {
                    varValue = (const long)m_pRectPage->m_roundness;
                    pProp->put_Value(0, &varValue);
                    pProp->Release();
                    varValue.Clear();
                }
                bReturn = TRUE;
            }
        }
        else
        {
            ASSERT(m_pRectPage == NULL);
            m_pRectPage = new CRectPage();

            // Note: the following can fail (for indeterminate values)
            //varIndex = "Roundness";//# Localizable string#
            CString strStr;
            strStr.LoadString(IDS_STRING3);
            varIndex = LPCTSTR(strStr);
            if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
            {
                if (SUCCEEDED(pProp->get_Value(0, &varValue)) &&
                    varValue.vt == VT_R8)
                    m_pRectPage->m_roundness = varValue.dblVal;
                pProp->Release();
                varValue.Clear();
            }
            bReturn = TRUE;
        }
        pProps->Release();
    }

    pIGraphic->Release();
    return bReturn;
}

void CAutoRect::PageDone(LPDISPATCH ThisRegenMethod, VARIANT FAR* PageNumber)
{
    // We're finished with the page
    delete m_pRectPage;
    m_pRectPage = NULL;
}

BOOL CAutoRect::PropertyPages(LPDISPATCH ThisRegenMethod, VARIANT FAR* PageNumber)
{
    if (m_pRectPage == NULL)
        return FALSE;

    // Run the dialog and get the results
    int nResult = m_pRectPage->DoModal();
    return (nResult == IDOK);
}

BOOL CAutoRect::Wizard(LPDISPATCH ThisRegenMethod, VARIANT FAR* WizardNumber)
{
    // No wizards, so just return FALSE.
    return FALSE;
}

void CAutoRect::OnGeometryChanged(LPDISPATCH AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew)
{
}

BOOL CAutoRect::OnGeometryChanging(LPDISPATCH AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew)
{
    // OK to change our geometry, so just return TRUE.
    return TRUE;
}

BOOL CAutoRect::OnNewGraphic(LPDISPATCH AGraphic, BOOL Copy)
{
    // Return FALSE on failure.
    // For copies, usually do nothing.
    if (Copy)
        return TRUE;

    // Add vertices, etc. for new graphic here.

    // TODO: Do nothing here.
    IGraphic* pIGraphic = NULL;
    if (FAILED(AGraphic->QueryInterface(IID_IGraphic, (void**)&pIGraphic)))
        return FALSE;

    Vertices* pVerts;
    IVertex* pIVertex;
    if (SUCCEEDED(pIGraphic->get_Vertices(&pVerts)))
    {
        COleVariant x;
        COleVariant y;

        // First 2 vertices are lower left and upper right corners.
        const double corners[2*2] = { -1.0, -0.5, 1.0, 0.5 };
        for (int i = 0; i < 2*2; )
        {
            x = corners[i++];
            y = corners[i++];

            if (SUCCEEDED(pVerts->Add(&x, &y, &z,
                &f /*penDown*/,
                &t /*selectable*/,
                &f /*snappable*/,
                &f /*editable*/,
                &f /*linkable*/,
                &f /*calculated*/,
                &missing /*before*/,
                &missing /*after*/,
                &pIVertex)))
                pIVertex->Release();
        }

        // Third vertex is rounding handle (calculated)
        double r = 0.5 * GetRoundness(pIGraphic) / 100.0;
        double offset = 0.1 * r;
        x = 1.0 - r;
        y = 0.5 + offset;
        if (SUCCEEDED(pVerts->Add(&x, &y, &z,
            &f /*penDown*/,
            &f /*selectable*/,
            &f /*snappable*/,
            &f /*editable*/,
            &f /*linkable*/,
            &f /*calculated*/,
            &missing /*before*/,
            &missing /*after*/,
            &pIVertex)))
            pIVertex->Release();

        // Fourth vertex is rounding handle (editable)
        if (SUCCEEDED(pVerts->Add(&x, &y, &z,
            &f /*penDown*/,
            &t /*selectable*/,
            &f /*snappable*/,
            &t /*editable*/,
            &f /*linkable*/,
            &f /*calculated*/,
            &missing /*before*/,
            &missing /*after*/,
            &pIVertex)))
            pIVertex->Release();

        pIGraphic->Release();
    }
    return TRUE;
}

BOOL CAutoRect::OnCopyGraphic(LPDISPATCH DestGraphic, LPDISPATCH SourceGraphic)
{
    // Return FALSE on failure.
    return TRUE;
}

void CAutoRect::OnPropertyChanged(LPDISPATCH AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew)
{
}

BOOL CAutoRect::OnPropertyChanging(LPDISPATCH AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew)
{
    // OK to change all of our properties, so just return TRUE.
    return TRUE;
}

void CAutoRect::OnPropertyGet(LPDISPATCH AGraphic, long PropID)
{
    // No special recalculating of properties needed.
}

BOOL CAutoRect::Draw(LPDISPATCH AGraphic, LPDISPATCH AView, VARIANT FAR* AMatrix)
{
    // We don't handle special drawing, so just return FALSE.
    return FALSE;
}

BOOL GetVertexXYZ(IGraphic* pIGraphic, const long lVertex, double& x, double& y, double& z)
{
    IVertex* pIVertex = NULL;
    Vertices* pVerts = NULL;
    BOOL bSuccess = FALSE;
    if (SUCCEEDED(pIGraphic->get_Vertices(&pVerts)))
    {
        COleVariant varIndex = lVertex;
        if (SUCCEEDED(pVerts->get_Item(&varIndex, &pIVertex)))
        {
            if (SUCCEEDED(pIVertex->get_X(&x)) &&
                SUCCEEDED(pIVertex->get_Y(&y)) &&
                SUCCEEDED(pIVertex->get_Z(&z)))
                bSuccess = TRUE;
            pIVertex->Release();
        }
        pVerts->Release();
    }
    return bSuccess;
}

void AddLineChild(Graphics* pGraphics, double x0, double y0, double x1, double y1)
{
    IGraphic* pChild;
    if (SUCCEEDED(pGraphics->Add(
        &missing /*GraphicType*/,
        &missing /*RegenMethod*/,
        &t /*Inherit*/,
        &missing /*Style*/,
        &missing /*Before*/,
        &missing /*After*/,
        &pChild)))
    {
        pChild->put_Cosmetic(TRUE);

        COleVariant x, y;
        Vertices* pVerts = NULL;
        IVertex* pIVertex;
        if (SUCCEEDED(pChild->get_Vertices(&pVerts)))
        {
            x = x0;
            y = y0;
            if (SUCCEEDED(pVerts->Add(&x, &y, &z,
                &f /*penDown*/,
                &t /*selectable*/,
                &t /*snappable*/,
                &t /*editable*/,
                &t /*linkable*/,
                &f /*calculated*/,
                &missing /*before*/,
                &missing /*after*/,
                &pIVertex)))
                pIVertex->Release();
            x = x1;
            y = y1;
            if (SUCCEEDED(pVerts->Add(&x, &y, &z,
                &t /*penDown*/,
                &t /*selectable*/,
                &t /*snappable*/,
                &t /*editable*/,
                &t /*linkable*/,
                &f /*calculated*/,
                &missing /*before*/,
                &missing /*after*/,
                &pIVertex)))
                pIVertex->Release();
            pVerts->Release();
        }
        pChild->Release();
    }
}

void AddArcChild(Graphics* pGraphics, double xc, double yc, double r, double start, double end)
{
    IGraphic* pChild;
    COleVariant type((long)imsiArc);
    if (SUCCEEDED(pGraphics->Add(
        &type /*GraphicType*/,
        &missing /*RegenMethod*/,
        &t /*Inherit*/,
        &missing /*Style*/,
        &missing /*Before*/,
        &missing /*After*/,
        &pChild)))
    {
        pChild->put_Cosmetic(TRUE);
        COleVariant x(xc);
        COleVariant y(yc);
        COleVariant rad(r);
        COleVariant sa(start);
        COleVariant ea(end);

        pChild->ArcSet(&x, &y, &z, &rad, &missing, &sa, &ea, &missing);
        pChild->Release();
    }
}

void CAutoRect::Regen(LPDISPATCH AGraphic)
{
    IGraphic* pIGraphic = NULL;
    if (FAILED(AGraphic->QueryInterface(IID_IGraphic, (void**)&pIGraphic)))
        return;

    long lockCount = 0;
    if (SUCCEEDED(pIGraphic->RegenLock(&lockCount)))
    {
        if (lockCount == 0)
        {
            // TODO:  All the curve processing goes here
            Graphics* pGraphics = NULL;
            IGraphic* pChild = NULL;
            IVertex* pIVertex = NULL;
            if (SUCCEEDED(pIGraphic->get_Graphics(&pGraphics)))
            {
                COleVariant flags = (const long)GF_COSMETIC;
                pGraphics->Clear(&flags);

                // Calculate height, width and radius of corners

                double px[4] = { 0.0 };
                double py[4] = { 0.0 };
                double pz[4] = { 0.0 };
                for (int i = 0; i < 4; ++i)
                    GetVertexXYZ(pIGraphic, i, px[i], py[i], pz[i]);

                BOOL bHandleMoved = !(fabs(px[2] - px[3]) < 0.000001 &&
                    fabs(py[2] - py[3]) < 0.000001);

                double w = fabs(px[1] - px[0]);
                double h = fabs(py[1] - py[0]);
                double r = (w < h) ? (w/2.0) : (h/2.0);

                double roundness;
                if (bHandleMoved)
                {
                    if (r == 0.0)
                        roundness = 0.0;
                    else
                    {
                        roundness = fabs(px[2] - px[3]) * 100.0 / r;
                        if (roundness > 100.0)
                            roundness = 100.0;
                    }
                    SetRoundness(pIGraphic, roundness);
                }
                else
                {
                    roundness = GetRoundness(pIGraphic);
                }
                r = r * roundness / 100.0;

                // Add child graphics
                // Make sure p[0] < p[1]
                double swap;
                if (px[0] > px[1])
                {
                    swap = px[0];
                    px[0] = px[1];
                    px[1] = swap;
                }
                if (py[0] > py[1])
                {
                    swap = py[0];
                    py[0] = py[1];
                    py[1] = swap;
                }

                if (r == 0.0)
                {
                    // No rounded corners
                    // All children are cosmetic
                    if (SUCCEEDED(pGraphics->Add(
                        &missing /*GraphicType*/,
                        &missing /*RegenMethod*/,
                        &t /*Inherit*/,
                        &missing /*Style*/,
                        &missing /*Before*/,
                        &missing /*After*/,
                        &pChild)))
                    {
                        pChild->put_Cosmetic(TRUE);

                        COleVariant x, y;
                        Vertices* pVerts = NULL;
                        IVertex* pIVertex;
                        if (SUCCEEDED(pChild->get_Vertices(&pVerts)))
                        {
                            for (int i = 0; i < 4; ++i)
                            {
                                x = px[(i == 0 || i == 1) ? 0 : 1];
                                y = py[(i == 0 || i == 3) ? 0 : 1];
                                if (SUCCEEDED(pVerts->Add(&x, &y, &z,
                                    (i == 0) ? &f : &t /*penDown*/,
                                    &t /*selectable*/,
                                    &t /*snappable*/,
                                    &t /*editable*/,
                                    &t /*linkable*/,
                                    &f /*calculated*/,
                                    &missing /*before*/,
                                    &missing /*after*/,
                                    &pIVertex)))
                                    pIVertex->Release();
                            }
                            if (SUCCEEDED(pVerts->AddClose(
                                &t /*penDown*/,
                                &t /*selectable*/,
                                &t /*snappable*/,
                                &t /*editable*/,
                                &t /*linkable*/,
                                &f /*calculated*/,
                                &pIVertex)))
                                pIVertex->Release();

                            pVerts->Release();
                        }
                        pChild->Release();
                    }
                }
                else
                    {
                        // Rounded corners
                        // We'll make 4 line children and 4 arc children
                        AddLineChild(pGraphics, px[0] + r, py[0],     px[1] - r, py[0]);
                        AddArcChild (pGraphics, px[1] - r, py[0] + r, r, 1.5 * PI, 0.0);
                        AddLineChild(pGraphics, px[1],     py[0] + r, px[1],     py[1] - r);
                        AddArcChild (pGraphics, px[1] - r, py[1] - r, r, 0.0, 0.5 * PI);
                        AddLineChild(pGraphics, px[1] - r, py[1],     px[0] + r, py[1]);
                        AddArcChild (pGraphics, px[0] + r, py[1] - r, r, 0.5 * PI, PI);
                        AddLineChild(pGraphics, px[0],     py[1] - r, px[0],     py[0] + r);
                        AddArcChild (pGraphics, px[0] + r, py[0] + r, r, PI, 1.5 * PI);
                    }
                pGraphics->Release();
            }
        }
        pIGraphic->RegenUnlock(&missing);
    }
    pIGraphic->Release();
}

BOOL CAutoRect::Initialize(LPDISPATCH ThisRegenMethod)
{
    // TODO: Add your dispatch handler code here
    return TRUE;
}

// DUAL_SUPPORT_START

// delegate standard IDispatch methods to MFC IDispatch implementation
DELEGATE_DUAL_INTERFACE(CAutoRect, DualRect)

// Our method and property functions can generally just
// delegate back to the methods we generated using
// ClassWizard. However, if we set up properties to
// access variables directly, we will need to write the
//  code to get/put the value into the variable.
STDMETHODIMP CAutoRect::XDualRect::get_Description(BSTR FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->GetDescription();
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::get_ClassID(BSTR FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->GetClassID();
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::GetPropertyInfo(VARIANT FAR* Names, VARIANT FAR* Types, VARIANT FAR* IDs, VARIANT FAR* Defaults, long FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->GetPropertyInfo(Names, Types, IDs, Defaults);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::GetPageInfo(IDispatch * AGraphic, long FAR* StockPages, VARIANT FAR* Names, long FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->GetPageInfo(AGraphic, StockPages, Names);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::GetWizardInfo(VARIANT FAR* Names, long FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->GetWizardInfo(Names);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::GetEnumNames(long PropID, VARIANT FAR* Names, VARIANT FAR* Values, long FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->GetEnumNames(PropID, Names, Values);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::PageControls(IDispatch* ThisRegenMethod, IDispatch * AGraphic, long PageNumber, VARIANT_BOOL SaveProperties, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->PageControls(ThisRegenMethod, AGraphic, PageNumber, SaveProperties);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::PageDone(IDispatch * ThisRegenMethod, VARIANT FAR* PageNumber)
{
    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        pThis->PageDone(ThisRegenMethod, PageNumber);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::PropertyPages(IDispatch* ThisRegenMethod, VARIANT FAR* PageNumber, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->PropertyPages(ThisRegenMethod, PageNumber);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::Wizard(IDispatch* ThisRegenMethod, VARIANT FAR* WizardNumber, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->Wizard(ThisRegenMethod, WizardNumber);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::OnGeometryChanged(IDispatch * AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew)
{
    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        pThis->OnGeometryChanged(AGraphic, GeomID, ParamOld, ParamNew);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::OnGeometryChanging(IDispatch * AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->OnGeometryChanging(AGraphic, GeomID, ParamOld, ParamNew);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::OnNewGraphic(IDispatch * AGraphic, VARIANT_BOOL Copy, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->OnNewGraphic(AGraphic, Copy);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::OnCopyGraphic(IDispatch* CopyGraphic, IDispatch* SourceGraphic, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->OnCopyGraphic(CopyGraphic, SourceGraphic);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::OnPropertyChanged(IDispatch * AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew)
{
    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        pThis->OnPropertyChanged(AGraphic, PropID, ValueOld, ValueNew);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::OnPropertyChanging(IDispatch * AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->OnPropertyChanging(AGraphic, PropID, ValueOld, ValueNew);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::OnPropertyGet(IDispatch * AGraphic, long PropID)
{
    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        pThis->OnPropertyGet(AGraphic, PropID);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::Draw(IDispatch * AGraphic, IDispatch * AView, VARIANT FAR* AMatrix, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->Draw(AGraphic, AView, AMatrix);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::Regen(IDispatch* AGraphic)
{
    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        pThis->Regen(AGraphic);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoRect::XDualRect::Initialize(IDispatch* ThisRegenMethod, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoRect, DualRect)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->Initialize(ThisRegenMethod);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

// Implement ISupportErrorInfo to indicate we support the
// OLE Automation error handler.
IMPLEMENT_DUAL_ERRORINFO(CAutoRect, IID_ISmartObjectServer)

// DUAL_SUPPORT_END


Examples - C++ Rounded Rectangle Regen - AUTORECT.H

AUTORECT.H

C++ Rounded Rectangle Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// AutoRect.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CAutoRect command target

class CRectPage;  // Defined in RectPage.h.

class CAutoRect : public CCmdTarget
{
    DECLARE_DYNCREATE(CAutoRect)

    CAutoRect();           // protected constructor used by dynamic creation

// Attributes
public:

// Operations
public:

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CAutoRect)
    public:
    virtual void OnFinalRelease();
    //}}AFX_VIRTUAL

// Implementation
protected:
    virtual ~CAutoRect();

    CRectPage* m_pRectPage;

    // Generated message map functions
    //{{AFX_MSG(CAutoRect)
        // NOTE - the ClassWizard will add and remove member functions here.
    //}}AFX_MSG

    DECLARE_MESSAGE_MAP()
    DECLARE_OLECREATE(CAutoRect)

    // Generated OLE dispatch map functions
    //{{AFX_DISPATCH(CAutoRect)
    afx_msg BSTR GetClassID();
    afx_msg BSTR GetDescription();
    afx_msg long GetPropertyInfo(VARIANT FAR* Names, VARIANT FAR* Types, VARIANT FAR* IDs, VARIANT FAR* Defaults);
    afx_msg long GetPageInfo(LPDISPATCH AGraphic, long* StockPages, VARIANT FAR* Names);
    afx_msg long GetWizardInfo(VARIANT FAR* Names);
    afx_msg long GetEnumNames(long PropID, VARIANT FAR* Names, VARIANT FAR* Values);
    afx_msg BOOL PageControls(LPDISPATCH ThisRegenMethod, LPDISPATCH AGraphic, long PageNumber, BOOL SaveProperties);
    afx_msg void PageDone(LPDISPATCH ThisRegenMethod, VARIANT FAR* PageNumber);
    afx_msg BOOL PropertyPages(LPDISPATCH ThisRegenMethod, VARIANT FAR* PageNumber);
    afx_msg BOOL Wizard(LPDISPATCH ThisRegenMethod, VARIANT FAR* WizardNumber);
    afx_msg void OnGeometryChanged(LPDISPATCH AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew);
    afx_msg BOOL OnGeometryChanging(LPDISPATCH AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew);
    afx_msg BOOL OnNewGraphic(LPDISPATCH AGraphic, BOOL Copy);
    afx_msg BOOL OnCopyGraphic(LPDISPATCH CopyGraphic, LPDISPATCH SourceGraphic);
    afx_msg void OnPropertyChanged(LPDISPATCH AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew);
    afx_msg BOOL OnPropertyChanging(LPDISPATCH AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew);
    afx_msg void OnPropertyGet(LPDISPATCH AGraphic, long PropID);
    afx_msg BOOL Draw(LPDISPATCH AGraphic, LPDISPATCH AView, VARIANT FAR* AMatrix);
    afx_msg void Regen(LPDISPATCH AGraphic);
    afx_msg BOOL Initialize(LPDISPATCH ThisRegenMethod);
    //}}AFX_DISPATCH
    DECLARE_DISPATCH_MAP()
    DECLARE_INTERFACE_MAP()

    // DUAL_SUPPORT_START
    //    add declaration of ISmartObjectServer implementation
    //	  You need one entry here for each entry in the
    //	  interface statement of the ODL, plus the entries for a
    //	  dispatch interface. The BEGIN_DUAL_INTERFACE_PART
    //	  macro in mfcdual.h automatically generates the IDispatch
    //	  entries for you.
    //	  Each entry with the "propput" attribute needs a function
    //    named "put_<property name>". Each entry with the "propget"
    //	  attribute needs a function named "get_<property name>".
    //	  You can pull these function prototypes from the header file
    //	  generated by MKTYPLIB.
    BEGIN_DUAL_INTERFACE_PART(DualRect, ISmartObjectServer)
        STDMETHOD(get_Description)(THIS_ BSTR FAR* retval);
        STDMETHOD(get_ClassID)(THIS_ BSTR FAR* retval);
        STDMETHOD(GetPropertyInfo)(THIS_ VARIANT FAR* Names, VARIANT FAR* Types, VARIANT FAR* IDs, VARIANT FAR* Defaults, long FAR* retval);
        STDMETHOD(GetPageInfo)(THIS_ IDispatch* AGraphic, long FAR* StockPages, VARIANT FAR* Names, long FAR* retval);
        STDMETHOD(GetWizardInfo)(THIS_ VARIANT FAR* Names, long FAR* retval);
        STDMETHOD(GetEnumNames)(THIS_ long PropID, VARIANT FAR* Names, VARIANT FAR* Values, long FAR* retval);
        STDMETHOD(PageControls)(THIS_ IDispatch* ThisRegenMethod, IDispatch* AGraphic, long PageNumber, VARIANT_BOOL SaveProperties, VARIANT_BOOL* retval);
        STDMETHOD(PageDone)(THIS_ IDispatch* ThisRegenMethod, VARIANT FAR* PageNumber);
        STDMETHOD(PropertyPages)(THIS_ IDispatch* ThisRegenMethod, VARIANT FAR* PageNumber, VARIANT_BOOL* retval);
        STDMETHOD(Wizard)(THIS_ IDispatch* ThisRegenMethod, VARIANT FAR* WizardNumber, VARIANT_BOOL* retval);
        STDMETHOD(OnGeometryChanged)(THIS_ IDispatch* AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew);
        STDMETHOD(OnGeometryChanging)(THIS_ IDispatch* AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew, VARIANT_BOOL* retval);
        STDMETHOD(OnNewGraphic)(THIS_ IDispatch* AGraphic, VARIANT_BOOL Copy, VARIANT_BOOL* retval);
        STDMETHOD(OnCopyGraphic)(THIS_ IDispatch* CopyGraphic, IDispatch* SourceGraphic, VARIANT_BOOL* retval);
        STDMETHOD(OnPropertyChanged)(THIS_ IDispatch* AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew);
        STDMETHOD(OnPropertyChanging)(THIS_ IDispatch* AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew, VARIANT_BOOL* retval);
        STDMETHOD(OnPropertyGet)(THIS_ IDispatch* AGraphic, long PropID);
        STDMETHOD(Draw)(THIS_ IDispatch* AGraphic, IDispatch* AView, VARIANT FAR* AMatrix, VARIANT_BOOL* retval);
        STDMETHOD(Regen)(THIS_ IDispatch* AGraphic);
        STDMETHOD(Initialize)(THIS_ IDispatch* ThisRegenMethod, VARIANT_BOOL* retval);
    END_DUAL_INTERFACE_PART(DualRect)

    //     add declaration of ISupportErrorInfo implementation
    //     to indicate we support the OLE Automation error object
    DECLARE_DUAL_ERRORINFO()
    // DUAL_SUPPORT_END
};

/////////////////////////////////////////////////////////////////////////////


Examples - C++ Rounded Rectangle Regen - Mfcdual.cpp

Mfcdual.cpp

C++ Rounded Rectangle Regen Example

// mfcdual.cpp: Helpful functions for adding dual interface support to
//		        MFC applications

// This is a part of the Microsoft Foundation Classes C++ library.
// Copyright (C) 1992-1996 Microsoft Corporation
// All rights reserved.
//
// This source code is only intended as a supplement to the
// Microsoft Foundation Classes Reference and related
// electronic documentation provided with the library.
// See these sources for detailed information regarding the
// Microsoft Foundation Classes product.

#include "stdafx.h"

#include <afxpriv.h>

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// DualHandleException

HRESULT DualHandleException(REFIID riidSource, const CException* pAnyException)
{
    USES_CONVERSION;

    ASSERT_VALID(pAnyException);

    TRACE0("DualHandleException called\n");

    // Set ErrInfo object so that VTLB binding container
    // applications can get rich error information.
    ICreateErrorInfo* pcerrinfo;
    HRESULT hr = CreateErrorInfo(&pcerrinfo);
    if (SUCCEEDED(hr))
    {
        TCHAR   szDescription[256];
        LPCTSTR pszDescription = szDescription;
        GUID    guid = GUID_NULL;
        DWORD   dwHelpContext = 0;
        BSTR    bstrHelpFile = NULL;
        BSTR    bstrSource = NULL;
        if (pAnyException->IsKindOf(RUNTIME_CLASS(COleDispatchException)))
        {
            // specific IDispatch style exception
            COleDispatchException* e = (COleDispatchException*)pAnyException;

            guid = riidSource;
            hr = MAKE_HRESULT(SEVERITY_ERROR, FACILITY_ITF,
                              (e->m_wCode + 0x200));

            pszDescription = e->m_strDescription;
            dwHelpContext = e->m_dwHelpContext;

            // propagate source and help file if present
            // call ::SysAllocString directly so no further exceptions are thrown
            if (!e->m_strHelpFile.IsEmpty())
                bstrHelpFile = ::SysAllocString(T2COLE(e->m_strHelpFile));
            if (!e->m_strSource.IsEmpty())
                bstrSource = ::SysAllocString(T2COLE(e->m_strSource));

        }
        else if (pAnyException->IsKindOf(RUNTIME_CLASS(CMemoryException)))
        {
            // failed memory allocation
            AfxLoadString(AFX_IDP_FAILED_MEMORY_ALLOC, szDescription);
            hr = E_OUTOFMEMORY;
        }
        else
        {
            // other unknown/uncommon error
            AfxLoadString(AFX_IDP_INTERNAL_FAILURE, szDescription);
            hr = E_UNEXPECTED;
        }

        if (bstrHelpFile == NULL && dwHelpContext != 0)
            bstrHelpFile = ::SysAllocString(T2COLE(AfxGetApp()->m_pszHelpFilePath));

        if (bstrSource == NULL)
            bstrSource = ::SysAllocString(T2COLE(AfxGetAppName()));

        // Set up ErrInfo object
        pcerrinfo->SetGUID(guid);
        pcerrinfo->SetDescription(::SysAllocString(T2COLE(pszDescription)));
        pcerrinfo->SetHelpContext(dwHelpContext);
        pcerrinfo->SetHelpFile(bstrHelpFile);
        pcerrinfo->SetSource(bstrSource);

        TRACE("\tSource = %ws\n", bstrSource);
        TRACE("\tDescription = %s\n", pszDescription);
        TRACE("\tHelpContext = %lx\n", dwHelpContext);
        TRACE("\tHelpFile = %ws\n", bstrHelpFile);

        // Set the ErrInfo object for the current thread
        IErrorInfo* perrinfo;
        if (SUCCEEDED(pcerrinfo->QueryInterface(IID_IErrorInfo, (LPVOID*)&perrinfo)))
        {
            SetErrorInfo(0, perrinfo);
            perrinfo->Release();
        }

        pcerrinfo->Release();
    }

    TRACE("DualHandleException returning HRESULT %lx\n", hr);

    return hr;
}


Examples - C++ Rounded Rectangle Regen - Mfcdual.h

Mfcdual.h

C++ Rounded Rectangle Regen Example

// mfcdual.h: Helpful macros for adding dual interface support to
//			  MFC applications

// This is a part of the Microsoft Foundation Classes C++ library.
// Copyright (C) 1992-1996 Microsoft Corporation
// All rights reserved.
//
// This source code is only intended as a supplement to the
// Microsoft Foundation Classes Reference and related
// electronic documentation provided with the library.
// See these sources for detailed information regarding the
// Microsoft Foundation Classes product.

/////////////////////////////////////////////////////////////////////
// BEGIN_DUAL_INTERFACE_PART is just like BEGIN_INTERFACE_PART,
// except that it also adds the IDispatch methods to your class
// declaration.
#define BEGIN_DUAL_INTERFACE_PART(localClass, baseClass) \
    BEGIN_INTERFACE_PART(localClass, baseClass) \
       STDMETHOD(GetTypeInfoCount)(UINT FAR* pctinfo); \
       STDMETHOD(GetTypeInfo)(UINT itinfo, LCID lcid, ITypeInfo FAR* FAR* pptinfo); \
       STDMETHOD(GetIDsOfNames)(REFIID riid, OLECHAR FAR* FAR* rgszNames, UINT cNames, LCID lcid, DISPID FAR* rgdispid); \
       STDMETHOD(Invoke)(DISPID dispidMember, REFIID riid, LCID lcid, WORD wFlags, DISPPARAMS FAR* pdispparams, VARIANT FAR* pvarResult, EXCEPINFO FAR* pexcepinfo, UINT FAR* puArgErr); \

/////////////////////////////////////////////////////////////////////
// END_DUAL_INTERFACE_PART is just like END_INTERFACE_PART. It
// is only added for symmetry...
#define END_DUAL_INTERFACE_PART(localClass) \
    END_INTERFACE_PART(localClass) \

/////////////////////////////////////////////////////////////////////
// DELEGATE_DUAL_INTERFACE expands to define the standard IDispatch
// methods for a dual interface, delegating back to the default
// MFC implementation
#define DELEGATE_DUAL_INTERFACE(objectClass, dualClass) \
    STDMETHODIMP_(ULONG) objectClass::X##dualClass::AddRef() \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        return pThis->ExternalAddRef(); \
    } \
    STDMETHODIMP_(ULONG) objectClass::X##dualClass::Release() \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        return pThis->ExternalRelease(); \
    } \
    STDMETHODIMP objectClass::X##dualClass::QueryInterface( \
        REFIID iid, LPVOID* ppvObj) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        return pThis->ExternalQueryInterface(&iid, ppvObj); \
    } \
    STDMETHODIMP objectClass::X##dualClass::GetTypeInfoCount( \
        UINT FAR* pctinfo) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->GetTypeInfoCount(pctinfo); \
    } \
    STDMETHODIMP objectClass::X##dualClass::GetTypeInfo( \
        UINT itinfo, LCID lcid, ITypeInfo FAR* FAR* pptinfo) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->GetTypeInfo(itinfo, lcid, pptinfo); \
    } \
    STDMETHODIMP objectClass::X##dualClass::GetIDsOfNames( \
        REFIID riid, OLECHAR FAR* FAR* rgszNames, UINT cNames, \
        LCID lcid, DISPID FAR* rgdispid) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->GetIDsOfNames(riid, rgszNames, cNames, \
                                         lcid, rgdispid); \
    } \
    STDMETHODIMP objectClass::X##dualClass::Invoke( \
        DISPID dispidMember, REFIID riid, LCID lcid, WORD wFlags, \
        DISPPARAMS FAR* pdispparams, VARIANT FAR* pvarResult, \
        EXCEPINFO FAR* pexcepinfo, UINT FAR* puArgErr) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->Invoke(dispidMember, riid, lcid, \
                                  wFlags, pdispparams, pvarResult, \
                                  pexcepinfo, puArgErr); \
    } \

/////////////////////////////////////////////////////////////////////
// TRY_DUAL and CATCH_ALL_DUAL are used to provide exception handling
// for your dual interface methods. CATCH_ALL_DUAL takes care of
// returning the appropriate error code.

#define TRY_DUAL(iidSource) \
    HRESULT _hr = S_OK; \
    REFIID  _riidSource = iidSource; \
    TRY \

#define CATCH_ALL_DUAL \
    CATCH(COleException, e) \
    { \
        _hr = e->m_sc; \
    } \
    AND_CATCH_ALL(e) \
    { \
        AFX_MANAGE_STATE(pThis->m_pModuleState); \
        _hr = DualHandleException(_riidSource, e); \
    } \
    END_CATCH_ALL \
    return _hr; \

/////////////////////////////////////////////////////////////////////
// DualHandleException is a helper function used to set the system's
// error object, so that container applications that call through
// VTBLs can retrieve rich error information
HRESULT DualHandleException(REFIID riidSource, const CException* pAnyException);

/////////////////////////////////////////////////////////////////////
// DECLARE_DUAL_ERRORINFO expands to declare the ISupportErrorInfo
// support class. It works together with DUAL_ERRORINFO_PART and
// IMPLEMENT_DUAL_ERRORINFO defined below.
#define DECLARE_DUAL_ERRORINFO() \
    BEGIN_INTERFACE_PART(SupportErrorInfo, ISupportErrorInfo) \
        STDMETHOD(InterfaceSupportsErrorInfo)(THIS_ REFIID riid); \
    END_INTERFACE_PART(SupportErrorInfo) \

/////////////////////////////////////////////////////////////////////
// DUAL_ERRORINFO_PART adds the appropriate entry to the interface map
// for ISupportErrorInfo, if you used DECLARE_DUAL_ERRORINFO.
#define DUAL_ERRORINFO_PART(objectClass) \
    INTERFACE_PART(objectClass, IID_ISupportErrorInfo, SupportErrorInfo) \

/////////////////////////////////////////////////////////////////////
// IMPLEMENT_DUAL_ERRORINFO expands to an implementation of
// ISupportErrorInfo which matches the declaration in
// DECLARE_DUAL_ERRORINFO.
#define IMPLEMENT_DUAL_ERRORINFO(objectClass, riidSource) \
    STDMETHODIMP_(ULONG) objectClass::XSupportErrorInfo::AddRef() \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return pThis->ExternalAddRef(); \
    } \
    STDMETHODIMP_(ULONG) objectClass::XSupportErrorInfo::Release() \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return pThis->ExternalRelease(); \
    } \
    STDMETHODIMP objectClass::XSupportErrorInfo::QueryInterface( \
        REFIID iid, LPVOID* ppvObj) \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return pThis->ExternalQueryInterface(&iid, ppvObj); \
    } \
    STDMETHODIMP objectClass::XSupportErrorInfo::InterfaceSupportsErrorInfo( \
        REFIID iid) \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return (iid == riidSource) ? S_OK : S_FALSE; \
    }

/////////////////////////////////////////////////////////////////////


Examples - C++ Rounded Rectangle Regen - RECTPAGE.CPP

RECTPAGE.CPP

C++ Rounded Rectangle Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// RectPage.cpp : implementation file
//

#include "stdafx.h"
#include "RRect.h"
#include "RectPage.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CRectPage dialog

CRectPage::CRectPage(CWnd* pParent /*=NULL*/)
    : CDialog(CRectPage::IDD, pParent)
{
    //{{AFX_DATA_INIT(CRectPage)
    m_roundness = 0.0;
    //}}AFX_DATA_INIT
}

void CRectPage::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CRectPage)
    DDX_Text(pDX, IDC_ROUNDNESS, m_roundness);
    DDV_MinMaxDouble(pDX, m_roundness, 0., 100.);
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CRectPage, CDialog)
    //{{AFX_MSG_MAP(CRectPage)
        // NOTE: the ClassWizard will add message map macros here
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CRectPage message handlers


Examples - C++ Rounded Rectangle Regen - RECTPAGE.H

RECTPAGE.H

C++ Rounded Rectangle Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// RectPage.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CRectPage dialog

class CRectPage : public CDialog
{
// Construction
public:
    CRectPage(CWnd* pParent = NULL);   // standard constructor

// Dialog Data
    //{{AFX_DATA(CRectPage)
    enum { IDD = IDD_PP_RRECT };
    double	m_roundness;
    //}}AFX_DATA

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CRectPage)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:

    // Generated message map functions
    //{{AFX_MSG(CRectPage)
        // NOTE: the ClassWizard will add member functions here
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};


Examples - C++ Rounded Rectangle Regen - RRECT.CPP

RRECT.CPP

C++ Rounded Rectangle Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// RRect.cpp : Defines the initialization routines for the DLL.
//

#include "stdafx.h"
#include "RRect.h"
#include "AutoRect.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CRoundRectApp

BEGIN_MESSAGE_MAP(CRoundRectApp, CWinApp)
    //{{AFX_MSG_MAP(CRoundRectApp)
        // NOTE - the ClassWizard will add and remove mapping macros here.
        //    DO NOT EDIT what you see in these blocks of generated code!
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CRoundRectApp construction

// DUAL_SUPPORT_START
//    GUID for the type library (for registry functions)
static const GUID LIBID_RoundRect =
    { 0x7724BB42L,0xB671,0x11D0,0x9B,0x3B,0x44,0x45,0x53,0x54,0x00,0x00 };
// DUAL_SUPPORT_END

CRoundRectApp::CRoundRectApp()
{
}

/////////////////////////////////////////////////////////////////////////////
// The one and only CRoundRectApp object

CRoundRectApp theApp;

/////////////////////////////////////////////////////////////////////////////
// CRoundRectApp initialization

BOOL CRoundRectApp::InitInstance()
{
      // Register all OLE server (factories) as running.  This enables the
    //  OLE libraries to create objects from other applications.
    COleObjectFactory::RegisterAll();

    // DUAL_SUPPORT_START
    //    make sure the type library is registerd. Otherwise dual interface won't work!
    //    note that we are embedding type library as a resource in this DLL.
    AfxOleRegisterTypeLib(AfxGetInstanceHandle(), LIBID_RoundRect);
    // DUAL_SUPPORT_END

    return TRUE;
}

/////////////////////////////////////////////////////////////////////////////
// Special entry points required for inproc servers

STDAPI DllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID* ppv)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    return AfxDllGetClassObject(rclsid, riid, ppv);
}

STDAPI DllCanUnloadNow(void)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    return AfxDllCanUnloadNow();
}

// by exporting DllRegisterServer, you can use regsvr.exe
STDAPI DllRegisterServer(void)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    COleObjectFactory::UpdateRegistryAll();
    return S_OK;
}


Examples - C++ Rounded Rectangle Regen - RRECT.H

RRECT.H

C++ Rounded Rectangle Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// RRect.h : main header file for the RRect DLL
//

#ifndef __AFXWIN_H__
    #error include 'stdafx.h' before including this file for PCH
#endif

#include "resource.h"		// main symbols

/////////////////////////////////////////////////////////////////////////////
// CRoundRectApp
// See RRect.cpp for the implementation of this class
//

class CRoundRectApp : public CWinApp
{
public:
    CRoundRectApp();

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CRoundRectApp)
    public:
    virtual BOOL InitInstance();
    //}}AFX_VIRTUAL

    //{{AFX_MSG(CRoundRectApp)
        // NOTE - the ClassWizard will add and remove member functions here.
        //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

/////////////////////////////////////////////////////////////////////////////


Examples - C++ Rounded Rectangle 2 Regen - AutoRect.cpp

AutoRect.cpp

C++ Rounded Rectangle 2 Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// AutoRect.cpp : Implementation of CAutoRect
#include "stdafx.h"
#include "RRectA.h"
#include "AutoRect.h"
#include "RectPage.h"  // Property page class
#include "GxIntf.h"   // TurboCAD interfaces (forward declarations)
#include "Imsigx.h"   // TurboCAD interfaces
#include <math.h>

/////////////////////////////////////////////////////////////////////////////
// Standard variants
COleVariant t(-1L, VT_BOOL);
COleVariant f(0L, VT_BOOL);
COleVariant z(0.0);
COleVariant missing((long)DISP_E_PARAMNOTFOUND, VT_ERROR);
const double PI = 3.14159265;

/////////////////////////////////////////////////////////////////////////////
// CAutoRect

const IID IID_IGraphic =
    {0x6A481109,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
static const IID IID_ISmartObjectServer =
{0x6A481303,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

STDMETHODIMP CAutoRect::get_ClassID(BSTR *pVal)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here
    HRESULT hRes = E_FAIL;
    LPOLESTR olestr = NULL;
    try
    {
        if(SUCCEEDED( ::StringFromCLSID(CLSID_AutoRect, &olestr)))
        {

            *pVal = ::SysAllocString(olestr);
            hRes = S_OK;
        }
    }
    catch (...)
    {

    }

    if (olestr != NULL)
    CoTaskMemFree(olestr);

    return hRes;
}

STDMETHODIMP CAutoRect::put_ClassID(BSTR newVal)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    return S_OK;
}

STDMETHODIMP CAutoRect::get_Description(BSTR *pVal)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    HRESULT hRes = E_FAIL;
    // TODO: Add your implementation code here
    // Get the description from the resource
    CString strResult;
    if (strResult.LoadString(IDS_AUTORECT_DESCRIPTION))
    {
        hRes = S_OK;
        *pVal = strResult.AllocSysString();
    }
    return hRes;

}

const long VT_INTEGER_ENUM = VT_I2 + 100;
const long VT_LONG_ENUM = VT_I4 + 100;
const long VT_STRING_ENUM = VT_BSTR + 100;

const long GF_COSMETIC = 128;

enum StockPages {
    PP_STOCK_PEN = 1,
    PP_STOCK_BRUSH = 2,
    PP_STOCK_TEXT = 4,
    PP_STOCK_INSERT = 8,
    PP_STOCK_VIEWPORT = 16,
    PP_STOCK_AUTO = 32
};

const long nProperties = 1;

enum PropertyIDs
{
   idRoundness = 1,
};

STDMETHODIMP CAutoRect::put_Description(BSTR newVal)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    return S_OK;
}

STDMETHODIMP CAutoRect::GetPropertyInfo(VARIANT *Names, VARIANT *Types, VARIANT *IDs, VARIANT *Defaults, long* ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;

    // TODO: Add your implementation code here
     ASSERT(Names->vt == VT_ARRAY|VT_BSTR);
    ASSERT(Types->vt == VT_ARRAY|VT_I4);
    ASSERT(IDs->vt == VT_ARRAY|VT_I4);
    ASSERT(Defaults->vt == VT_ARRAY|VT_VARIANT);

     SAFEARRAYBOUND bound = { nProperties, 0 };
    try
    {
        if (FAILED(::SafeArrayRedim(Names->parray, &bound)))
        {
            *ret = 0;
            return hRes;
        }
        if (FAILED(::SafeArrayRedim(Types->parray, &bound)))
        {
            *ret = 0;
            return hRes;
        }
        if (FAILED(::SafeArrayRedim(IDs->parray, &bound)))
        {
            *ret = 0;
            return hRes;
        }
        if (FAILED(::SafeArrayRedim(Defaults->parray, &bound)))
        {
            *ret = 0;
            return hRes;
        }

        BSTR* rgNames;
        long* rgTypes;
        long* rgIDs;
        VARIANT* rgDefaults;
        *ret = 0;
        if (SUCCEEDED(::SafeArrayAccessData(Names->parray, (void**)&rgNames)))
        {
            if (SUCCEEDED(::SafeArrayAccessData(Types->parray, (void**)&rgTypes)))
            {
                if (SUCCEEDED(::SafeArrayAccessData(IDs->parray, (void**)&rgIDs)))
                {
                    if (SUCCEEDED(::SafeArrayAccessData(Defaults->parray, (void**)&rgDefaults)))
                    {
                        rgNames[0] = ::SysAllocString(OLESTR("Roundness"));
                        rgTypes[0] = VT_R8;
                        rgIDs[0] = idRoundness;
                        rgDefaults[0].vt = VT_R8;
                        rgDefaults[0].dblVal = 50.0;

                        hRes = ::SafeArrayUnaccessData(Defaults->parray);
                        CHECK_HRESULT(hRes)

                        *ret = nProperties;
                //		hRes = S_OK;
                    }
                    hRes = ::SafeArrayUnaccessData(IDs->parray);
                    CHECK_HRESULT(hRes)
                }
                hRes = ::SafeArrayUnaccessData(Types->parray);
                CHECK_HRESULT(hRes)
            }
            hRes = ::SafeArrayUnaccessData(Names->parray);
            CHECK_HRESULT(hRes)
        }
    }
    catch (...)
    {
        TRACE_EXCEPTION("CAutoRect::GetPropertyInfo")
    }

    return hRes;

}

STDMETHODIMP CAutoRect::GetPageInfo(IDispatch *AGraphic, long *StockPages, VARIANT *Names,long* ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;

    // TODO: Add your implementation code here
    ASSERT(StockPages != NULL);
     ASSERT(Names->vt == VT_ARRAY|VT_BSTR);

    // Request pen page and auto page
    *StockPages = PP_STOCK_PEN | PP_STOCK_BRUSH | PP_STOCK_AUTO;

     SAFEARRAYBOUND bound = { 1, 0 };
    if (FAILED(::SafeArrayRedim(Names->parray, &bound)))
    {
        *ret = 0;
        return hRes;
    }

    CString strCaption;
    strCaption.LoadString(IDS_AUTORECT_CAPTION);
    BSTR bstrCaption = strCaption.AllocSysString();

    long lIndex = 0;
    if (FAILED(SafeArrayPutElement(Names->parray, &lIndex, (void*)bstrCaption)))
    {
        ::SysFreeString(bstrCaption);
        *ret = 0;
        return hRes;
    }
    *ret = 1;
    hRes = S_OK;
    return hRes;

}

STDMETHODIMP CAutoRect::GetWizardInfo(VARIANT *Names,long* ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = S_OK;
    // No wizards, nothing to do

    *ret = 0;
    return hRes;

}

STDMETHODIMP CAutoRect::GetEnumNames(long PropID, VARIANT *Names, VARIANT *Values,long* ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = S_OK;

    // TODO: Add your implementation code here
    // Should never be called!
    *ret = 0;
    return hRes;
}

STDMETHODIMP CAutoRect::PageControls(IDispatch *ThisRegenMethod, IDispatch *AGraphic, long PageNumber, boolean SaveProperties, VARIANT_BOOL* ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;

    // TODO: Add your implementation code here
    IGraphic* pIGraphic = NULL;
    if (FAILED(AGraphic->QueryInterface(IID_IGraphic, (void**)&pIGraphic)))
    {
        *ret = FALSE;
        return hRes;
    }

    *ret = FALSE;
    Properties* pProps = NULL;
    Property* pProp = NULL;
    COleVariant varIndex, varValue;
    try
    {
        if (SUCCEEDED(pIGraphic->get_Properties(&pProps)))
        {
            if (SaveProperties)
            {
                if (m_pRectPage != NULL)
                {
                    // Note: the following can fail (for non-rounded rect graphics)
                    varIndex = "Roundness";
                    if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
                    {
                        varValue = (const long)m_pRectPage->m_roundness;
                        hRes = pProp->put_Value(0, &varValue);
                        CHECK_HRESULT(hRes)

                        pProp->Release();
                        varValue.Clear();
                    }
                    *ret = TRUE;
                }
            }
            else
            {
                ASSERT(m_pRectPage == NULL);
                m_pRectPage = new CRectPage();

                // Note: the following can fail (for indeterminate values)
                varIndex = "Roundness";
                if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
                {
                    if (SUCCEEDED(pProp->get_Value(0, &varValue)) &&
                        varValue.vt == VT_R8)
                        m_pRectPage->m_roundness = varValue.dblVal;
                    pProp->Release();
                    varValue.Clear();
                }
                hRes = S_OK;
                *ret = TRUE;
            }
            pProps->Release();
        }

        pIGraphic->Release();
    }
    catch (...)
    {
        TRACE_EXCEPTION("CAutoRect::PageControls")
    }

    return hRes;

}

STDMETHODIMP CAutoRect::PageDone(IDispatch *ThisRegenMethod, VARIANT *PageNumber)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    delete m_pRectPage;
    m_pRectPage = NULL;
    HRESULT hRes = S_OK;
    return hRes;

}

STDMETHODIMP CAutoRect::PropertyPages(IDispatch *ThisRegenMethod, VARIANT *PageNumber, VARIANT_BOOL* ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;
    // TODO: Add your implementation code here

    if (m_pRectPage == NULL)
    {
        *ret = FALSE;
        return hRes;
    }
    // Run the dialog and get the results
    int nResult = m_pRectPage->DoModal();
    *ret = TRUE;
    hRes = S_OK;

    return hRes;
}

STDMETHODIMP CAutoRect::Wizard(IDispatch *ThisRegenMethod, VARIANT *WizardNumber, VARIANT_BOOL* ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;
    // TODO: Add your implementation code here

    // No wizards, so just return FALSE.
    *ret = FALSE;
    return hRes;
}

STDMETHODIMP CAutoRect::OnGeometryChanged(IDispatch *AGraphic, long GeomID, VARIANT *ParamOld, VARIANT *ParamNew)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = S_OK;
    // TODO: Add your implementation code here
    // OK to change our geometry, so just return TRUE.
    return hRes;
}

STDMETHODIMP CAutoRect::OnGeometryChanging(IDispatch *AGraphic, long GeomID, VARIANT *ParamOld, VARIANT *ParamNew, VARIANT_BOOL* ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here
    HRESULT hRes = S_OK;
    *ret = TRUE;
    return hRes;
}

double GetRoundness(IGraphic* pIGraphic)
{
    double roundness = 50.0;
    Properties* pProps = NULL;
    Property* pProp = NULL;
    COleVariant varIndex, varValue;
    if (SUCCEEDED(pIGraphic->get_Properties(&pProps)))
    {
        varIndex = "Roundness";
        if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
        {
            if (SUCCEEDED(pProp->get_Value(0, &varValue)) &&
                varValue.vt == VT_R8)
            {
                roundness = varValue.dblVal;
            }
            pProp->Release();
        }
        pProps->Release();
    }
    return roundness;
}

void SetRoundness(IGraphic* pIGraphic, double roundness)
{
    Properties* pProps = NULL;
    Property* pProp = NULL;
    COleVariant varIndex;
    if (SUCCEEDED(pIGraphic->get_Properties(&pProps)))
    {
        varIndex = "Roundness";
        if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
        {
            COleVariant varValue;
            varValue.vt = VT_R8;
            varValue.dblVal = roundness;
            pProp->put_Value(0, &varValue);
            pProp->Release();
        }
        pProps->Release();
    }
}

BOOL GetVertexXYZ(IGraphic* pIGraphic, const long lVertex, double& x, double& y, double& z)
{
    IVertex* pIVertex = NULL;
    Vertices* pVerts = NULL;
    BOOL bSuccess = FALSE;
    if (SUCCEEDED(pIGraphic->get_Vertices(&pVerts)))
    {
        COleVariant varIndex = lVertex;
        if (SUCCEEDED(pVerts->get_Item(&varIndex, &pIVertex)))
        {
            if (SUCCEEDED(pIVertex->get_X(&x)) &&
                SUCCEEDED(pIVertex->get_Y(&y)) &&
                SUCCEEDED(pIVertex->get_Z(&z)))
                bSuccess = TRUE;
            pIVertex->Release();
        }
        pVerts->Release();
    }
    return bSuccess;
}

void AddLineChild(Graphics* pGraphics, double x0, double y0, double x1, double y1)
{
    HRESULT hRes = E_FAIL;
    IGraphic* pChild = NULL;
    COleVariant x, y;
    Vertices* pVerts = NULL;
    IVertex* pIVertex = NULL;

    try
    {
        hRes = pGraphics->Add(&missing /*GraphicType*/,
                              &missing /*RegenMethod*/,
                              &t /*Inherit*/,
                              &missing /*Style*/,
                              &missing /*Before*/,
                              &missing /*After*/,
                              &pChild);
        CHECK_HRESULT(hRes)

        hRes = pChild->put_Cosmetic(TRUE);
        CHECK_HRESULT(hRes)

        hRes = pChild->get_Vertices(&pVerts);
        CHECK_HRESULT(hRes)

        x = x0;
        y = y0;
        hRes = pVerts->Add(&x, &y, &z,
                           &f /*penDown*/,
                           &t /*selectable*/,
                           &t /*snappable*/,
                           &t /*editable*/,
                           &t /*linkable*/,
                           &f /*calculated*/,
                           &missing /*before*/,
                           &missing /*after*/,
                           &pIVertex);
        CHECK_HRESULT(hRes)

        pIVertex->Release();
        x = x1;
        y = y1;
        hRes = pVerts->Add(&x, &y, &z,
                           &t /*penDown*/,
                           &t /*selectable*/,
                           &t /*snappable*/,
                           &t /*editable*/,
                           &t /*linkable*/,
                           &f /*calculated*/,
                           &missing /*before*/,
                           &missing /*after*/,
                           &pIVertex);
        CHECK_HRESULT(hRes)

    }

    catch (...)
    {
        TRACE_EXCEPTION("AddLineChild")
    }

    if (pIVertex != NULL)
        pIVertex->Release();

    if(pVerts != NULL)
        pVerts->Release();

    if (pChild != NULL)
        pChild->Release();

}

void AddArcChild(Graphics* pGraphics, double xc, double yc, double r, double start, double end)
{
    HRESULT hRes = E_FAIL;
    IGraphic* pChild = NULL;
    COleVariant type((long)imsiArc);
    try
    {

        hRes = pGraphics->Add(&type /*GraphicType*/,
                                 &missing /*RegenMethod*/,
                              &t /*Inherit*/,
                              &missing /*Style*/,
                              &missing /*Before*/,
                              &missing /*After*/,
                              &pChild);
        CHECK_HRESULT(hRes)

        hRes = pChild->put_Cosmetic(TRUE);
        CHECK_HRESULT(hRes)

        COleVariant x(xc);
        COleVariant y(yc);
        COleVariant rad(r);
        COleVariant sa(start);
        COleVariant ea(end);

        hRes = pChild->ArcSet(&x, &y, &z, &rad, &missing, &sa, &ea, &missing);
        CHECK_HRESULT(hRes)

    }

    catch (...)
    {
        TRACE_EXCEPTION("AddArcChild")
    }

    if(pChild != NULL)
    pChild->Release();

}

STDMETHODIMP CAutoRect::OnNewGraphic(IDispatch *CopyGraphic, boolean Copy, VARIANT_BOOL* ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;

    // TODO: Add your implementation code here

    // Return FALSE on failure.
    // For copies, usually do nothing.
    if (Copy)
    {
        *ret = TRUE;
        hRes = S_OK;
        return hRes;

    }
    // Add vertices, etc. for new graphic here.

    // TODO: Do nothing here.
    *ret = TRUE;
    try
    {
        IGraphic* pIGraphic = NULL;
        hRes = CopyGraphic->QueryInterface(IID_IGraphic, (void**)&pIGraphic);
//		hRes = AGraphic->QueryInterface(IID_IGraphic, (void**)&pIGraphic);
        CHECK_HRESULT(hRes)

        Vertices* pVerts = NULL;
        IVertex* pIVertex = NULL;
        if (SUCCEEDED(pIGraphic->get_Vertices(&pVerts)))
        {
            COleVariant x;
            COleVariant y;

            // First 2 vertices are lower left and upper right corners.
            const double corners[2*2] = { -1.0, -0.5, 1.0, 0.5 };
            for (int i = 0; i < 2*2; )
            {
                x = corners[i++];
                y = corners[i++];

                if (SUCCEEDED(pVerts->Add(&x, &y, &z,
                    &f /*penDown*/,
                    &t /*selectable*/,
                    &f /*snappable*/,
                    &f /*editable*/,
                    &f /*linkable*/,
                    &f /*calculated*/,
                    &missing /*before*/,
                    &missing /*after*/,
                    &pIVertex)))
                    pIVertex->Release();
            }

            // Third vertex is rounding handle (calculated)
            double r = 0.5 * GetRoundness(pIGraphic) / 100.0;
            double offset = 0.1 * r;
            x = 1.0 - r;
            y = 0.5 + offset;
            if (SUCCEEDED(pVerts->Add(&x, &y, &z,
                &f /*penDown*/,
                &f /*selectable*/,
                &f /*snappable*/,
                &f /*editable*/,
                &f /*linkable*/,
                &f /*calculated*/,
                &missing /*before*/,
                &missing /*after*/,
                &pIVertex)))
                pIVertex->Release();

            // Fourth vertex is rounding handle (editable)
            if (SUCCEEDED(pVerts->Add(&x, &y, &z,
                &f /*penDown*/,
                &t /*selectable*/,
                &f /*snappable*/,
                &t /*editable*/,
                &f /*linkable*/,
                &f /*calculated*/,
                &missing /*before*/,
                &missing /*after*/,
                &pIVertex)))
                pIVertex->Release();

            pIGraphic->Release();
        }
    }
    catch (...)
    {
        TRACE_EXCEPTION("CAutoRect::OnNewGraphic")
        *ret = FALSE;
    }

    return hRes;
}

STDMETHODIMP CAutoRect::OnCopyGraphic(IDispatch *CopyGraphic, IDispatch *SourceGraphic, VARIANT_BOOL* ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = S_OK;
    // TODO: Add your implementation code here
    *ret = TRUE;
    return hRes;
}

STDMETHODIMP CAutoRect::OnPropertyChanged(IDispatch *AGraphic, long PropID, VARIANT *ValueOld, VARIANT *ValueNew)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here
    HRESULT hRes = S_OK;

    return hRes;
}

STDMETHODIMP CAutoRect::OnPropertyChanging(IDispatch *AGraphic, long PropID, VARIANT *ValueOld, VARIANT *ValueNew, VARIANT_BOOL* ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = S_OK;

    // TODO: Add your implementation code here
    // OK to change all of our properties, so just return TRUE.
    *ret = TRUE;
    return hRes;
}

STDMETHODIMP CAutoRect::OnPropertyGet(IDispatch *AGraphic, long PropID)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = S_OK;

    // No special recalculating of properties needed.
    return hRes;
}

STDMETHODIMP CAutoRect::Draw(IDispatch *AGraphic, IDispatch *AView, VARIANT *AMatrix, VARIANT_BOOL* ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;
    // TODO: Add your implementation code here

    // We don't handle special drawing, so just return FALSE.
    ret = FALSE;
    return hRes;
}

STDMETHODIMP CAutoRect::Regen(IDispatch *AGraphic)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;
    // TODO: Add your implementation code here

    try
    {
        IGraphic* pIGraphic = NULL;
        hRes = AGraphic->QueryInterface(IID_IGraphic, (void**)&pIGraphic);
        CHECK_HRESULT(hRes)

        long lockCount = 0;
        if (SUCCEEDED(pIGraphic->RegenLock(&lockCount)))
        {
            if (lockCount == 0)
            {
                // TODO:  All the curve processing goes here
                Graphics* pGraphics = NULL;
                IGraphic* pChild = NULL;
                IVertex* pIVertex = NULL;
                if (SUCCEEDED(pIGraphic->get_Graphics(&pGraphics)))
                {
                    COleVariant flags = (const long)GF_COSMETIC;
                    pGraphics->Clear(&flags);

                    // Calculate height, width and radius of corners

                    double px[4] = { 0.0 };
                    double py[4] = { 0.0 };
                    double pz[4] = { 0.0 };
                    for (int i = 0; i < 4; ++i)
                        GetVertexXYZ(pIGraphic, i, px[i], py[i], pz[i]);

                    BOOL bHandleMoved = !(fabs(px[2] - px[3]) < 0.000001 &&
                        fabs(py[2] - py[3]) < 0.000001);

                    double w = fabs(px[1] - px[0]);
                    double h = fabs(py[1] - py[0]);
                    double r = (w < h) ? (w/2.0) : (h/2.0);

                    double roundness;
                    if (bHandleMoved)
                    {
                        if (r == 0.0)
                            roundness = 0.0;
                        else
                        {
                            roundness = fabs(px[2] - px[3]) * 100.0 / r;
                            if (roundness > 100.0)
                                roundness = 100.0;
                        }
                        SetRoundness(pIGraphic, roundness);
                    }
                    else
                    {
                        roundness = GetRoundness(pIGraphic);
                    }
                    r = r * roundness / 100.0;

                    // Add child graphics
                    // Make sure p[0] < p[1]
                    double swap;
                    if (px[0] > px[1])
                    {
                        swap = px[0];
                        px[0] = px[1];
                        px[1] = swap;
                    }
                    if (py[0] > py[1])
                    {
                        swap = py[0];
                        py[0] = py[1];
                        py[1] = swap;
                    }

                    if (r == 0.0)
                    {
                        // No rounded corners
                        // All children are cosmetic
                        if (SUCCEEDED(pGraphics->Add(
                            &missing /*GraphicType*/,
                            &missing /*RegenMethod*/,
                            &t /*Inherit*/,
                            &missing /*Style*/,
                            &missing /*Before*/,
                            &missing /*After*/,
                            &pChild)))
                        {
                            pChild->put_Cosmetic(TRUE);

                            COleVariant x, y;
                            Vertices* pVerts = NULL;
                            IVertex* pIVertex = NULL;
                            if (SUCCEEDED(pChild->get_Vertices(&pVerts)))
                            {
                                for (int i = 0; i < 4; ++i)
                                {
                                    x = px[(i == 0 || i == 1) ? 0 : 1];
                                    y = py[(i == 0 || i == 3) ? 0 : 1];
                                    if (SUCCEEDED(pVerts->Add(&x, &y, &z,
                                        (i == 0) ? &f : &t /*penDown*/,
                                        &t /*selectable*/,
                                        &t /*snappable*/,
                                        &t /*editable*/,
                                        &t /*linkable*/,
                                        &f /*calculated*/,
                                        &missing /*before*/,
                                        &missing /*after*/,
                                        &pIVertex)))
                                        pIVertex->Release();
                                }
                                if (SUCCEEDED(pVerts->AddClose(
                                    &t /*penDown*/,
                                    &t /*selectable*/,
                                    &t /*snappable*/,
                                    &t /*editable*/,
                                    &t /*linkable*/,
                                    &f /*calculated*/,
                                    &pIVertex)))
                                    pIVertex->Release();

                                pVerts->Release();
                            }
                            pChild->Release();
                        }
                    }
                    else
                        {
                            // Rounded corners
                            // We'll make 4 line children and 4 arc children
                            AddLineChild(pGraphics, px[0] + r, py[0],     px[1] - r, py[0]);
                            AddArcChild (pGraphics, px[1] - r, py[0] + r, r, 1.5 * PI, 0.0);
                            AddLineChild(pGraphics, px[1],     py[0] + r, px[1],     py[1] - r);
                            AddArcChild (pGraphics, px[1] - r, py[1] - r, r, 0.0, 0.5 * PI);
                            AddLineChild(pGraphics, px[1] - r, py[1],     px[0] + r, py[1]);
                            AddArcChild (pGraphics, px[0] + r, py[1] - r, r, 0.5 * PI, PI);
                            AddLineChild(pGraphics, px[0],     py[1] - r, px[0],     py[0] + r);
                            AddArcChild (pGraphics, px[0] + r, py[0] + r, r, PI, 1.5 * PI);
                        }
                    pGraphics->Release();
                }
            }
            pIGraphic->RegenUnlock(&missing);
        }
        pIGraphic->Release();
    }
    catch (...)
    {
        TRACE_EXCEPTION("CAutoRect::Regen")

    }
    return hRes;
}

STDMETHODIMP CAutoRect::Initialize(IDispatch *ThisRegenMethod, VARIANT_BOOL* ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = S_OK;
    // TODO: Add your implementation code here
    m_pRectPage = NULL;
    *ret = TRUE;
    return hRes;
}


Examples - C++ Rounded Rectangle 2 Regen - AutoRect.h

AutoRect.h

C++ Rounded Rectangle 2 Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// AutoRect.h : Declaration of the CAutoRect

#ifndef __AUTORECT_H_
#define __AUTORECT_H_

#include "resource.h"       // main symbols
#include "RECTPAGE.H"	// Added by ClassView

/////////////////////////////////////////////////////////////////////////////
class CRectPage;  // Defined in RectPage.h.

// CAutoRect
class ATL_NO_VTABLE CAutoRect :
    public CComObjectRootEx<CComSingleThreadModel>,
    public CComCoClass<CAutoRect, &CLSID_AutoRect>,
    public IDispatchImpl<IAutoRect, &IID_IAutoRect, &LIBID_RRECTALib>
{
public:
    CAutoRect()
    {
    }

DECLARE_REGISTRY_RESOURCEID(IDR_AUTORECT)

DECLARE_PROTECT_FINAL_CONSTRUCT()

BEGIN_COM_MAP(CAutoRect)
    COM_INTERFACE_ENTRY(IAutoRect)
    COM_INTERFACE_ENTRY(IDispatch)
END_COM_MAP()

// IAutoRect
public:
///	virtual void OnFinalRelease();
    STDMETHOD(Initialize)(IDispatch* ThisRegenMethod, VARIANT_BOOL* ret);
    STDMETHOD(Regen)(IDispatch* AGraphic);
    STDMETHOD(Draw)(IDispatch* AGraphic, IDispatch* AView, VARIANT* AMatrix, VARIANT_BOOL* ret);
    STDMETHOD(OnPropertyGet)(IDispatch* AGraphic, long PropID);
    STDMETHOD(OnPropertyChanging)(IDispatch* AGraphic, long PropID, VARIANT* ValueOld, VARIANT* ValueNew, VARIANT_BOOL* ret);
    STDMETHOD(OnPropertyChanged)(IDispatch* AGraphic, long PropID, VARIANT* ValueOld, VARIANT* ValueNew);
    STDMETHOD(OnCopyGraphic)(IDispatch* CopyGraphic, IDispatch* SourceGraphic, VARIANT_BOOL* ret);
    STDMETHOD(OnNewGraphic)(IDispatch* CopyGraphic, boolean Copy, VARIANT_BOOL* ret);
    STDMETHOD(OnGeometryChanging)(IDispatch* AGraphic, long GeomID, VARIANT* ParamOld, VARIANT* ParamNew, VARIANT_BOOL* ret);
    STDMETHOD(OnGeometryChanged)(IDispatch* AGraphic, long GeomID, VARIANT* ParamOld, VARIANT* ParamNew);
    STDMETHOD(Wizard)(IDispatch* ThisRegenMethod, VARIANT* WizardNumber, VARIANT_BOOL* ret);
    STDMETHOD(PropertyPages)(IDispatch* ThisRegenMethod, VARIANT* PageNumber, VARIANT_BOOL* ret);
    STDMETHOD(PageDone)(IDispatch* ThisRegenMethod, VARIANT* PageNumber);
    STDMETHOD(PageControls)(IDispatch* ThisRegenMethod, IDispatch* AGraphic, long PageNumber, boolean SaveProperties, VARIANT_BOOL* ret);
    STDMETHOD(GetEnumNames)(long PropID, VARIANT* Names, VARIANT* Values, long* ret);
    STDMETHOD(GetWizardInfo)(VARIANT* Names, long* ret);
    STDMETHOD(GetPageInfo)(IDispatch* AGraphic, long* StockPages, VARIANT* Names, long* ret);
    STDMETHOD(GetPropertyInfo)(VARIANT* Names, VARIANT* Types, VARIANT* IDs, VARIANT* Defaults, long* ret);
    STDMETHOD(get_Description)(/*[out, retval]*/ BSTR *pVal);
    STDMETHOD(put_Description)(/*[in]*/ BSTR newVal);
    STDMETHOD(get_ClassID)(/*[out, retval]*/ BSTR *pVal);
    STDMETHOD(put_ClassID)(/*[in]*/ BSTR newVal);
protected:
    CRectPage * m_pRectPage;
};

#endif //__AUTORECT_H_


Examples - C++ Rounded Rectangle 2 Regen - RectPage.cpp

RectPage.cpp

C++ Rounded Rectangle 2 Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// RectPage.cpp : implementation file
//

#include "stdafx.h"
#include "resource.h"
#include "RectPage.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CRectPage dialog

CRectPage::CRectPage(CWnd* pParent /*=NULL*/)
    : CDialog(CRectPage::IDD, pParent)
{
    m_roundness = 0.0;
    //{{AFX_DATA_INIT(CRectPage)
        // NOTE: the ClassWizard will add member initialization here
    //}}AFX_DATA_INIT
}

void CRectPage::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CRectPage)
        // NOTE: the ClassWizard will add DDX and DDV calls here
    //}}AFX_DATA_MAP
    DDX_Text(pDX, IDC_ROUNDNESS, m_roundness);
    DDV_MinMaxDouble(pDX, m_roundness, 0., 100.);

}

BEGIN_MESSAGE_MAP(CRectPage, CDialog)
    //{{AFX_MSG_MAP(CRectPage)
        // NOTE: the ClassWizard will add message map macros here
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CRectPage message handlers


Examples - C++ Rounded Rectangle 2 Regen - RectPage.h

RectPage.h

C++ Rounded Rectangle 2 Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
#if !defined(AFX_RECTPAGE_H__7B7FB264_668E_11D2_8C4A_00403338C504__INCLUDED_)
#define AFX_RECTPAGE_H__7B7FB264_668E_11D2_8C4A_00403338C504__INCLUDED_

#if _MSC_VER > 1000
#pragma once
#endif // _MSC_VER > 1000
// RectPage.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CRectPage dialog

class CRectPage : public CDialog
{
// Construction
public:
    CRectPage(CWnd* pParent = NULL);   // standard constructor

// Dialog Data
    //{{AFX_DATA(CRectPage)
    double m_roundness;
    enum { IDD = IDD_PP_RRECT };
        // NOTE: the ClassWizard will add data members here
    //}}AFX_DATA

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CRectPage)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:

    // Generated message map functions
    //{{AFX_MSG(CRectPage)
        // NOTE: the ClassWizard will add member functions here
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

//{{AFX_INSERT_LOCATION}}
// Microsoft Visual C++ will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_RECTPAGE_H__7B7FB264_668E_11D2_8C4A_00403338C504__INCLUDED_)


Examples - C++ Rounded Rectangle 2 Regen - RRectA.cpp

RRectA.cpp

C++ Rounded Rectangle 2 Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// RRectA.cpp : Implementation of DLL Exports.

// Note: Proxy/Stub Information
//      To build a separate proxy/stub DLL,
//      run nmake -f RRectAps.mk in the project directory.

#include "stdafx.h"
#include "resource.h"
//#include <initguid.h>
#include "RRectA.h"

#include "RRectA_i.c"
#include "AutoRect.h"

CComModule _Module;

BEGIN_OBJECT_MAP(ObjectMap)
OBJECT_ENTRY(CLSID_AutoRect, CAutoRect)
END_OBJECT_MAP()

class CRRectAApp : public CWinApp
{
public:

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CRRectAApp)
    public:
    virtual BOOL InitInstance();
    virtual int ExitInstance();
    //}}AFX_VIRTUAL

    //{{AFX_MSG(CRRectAApp)
        // NOTE - the ClassWizard will add and remove member functions here.
        //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

BEGIN_MESSAGE_MAP(CRRectAApp, CWinApp)
    //{{AFX_MSG_MAP(CRRectAApp)
        // NOTE - the ClassWizard will add and remove mapping macros here.
        //    DO NOT EDIT what you see in these blocks of generated code!
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

CRRectAApp theApp;

BOOL CRRectAApp::InitInstance()
{
    _Module.Init(ObjectMap, m_hInstance, &LIBID_RRECTALib);
    return CWinApp::InitInstance();
}

int CRRectAApp::ExitInstance()
{
    _Module.Term();
    return CWinApp::ExitInstance();
}

/////////////////////////////////////////////////////////////////////////////
// Used to determine whether the DLL can be unloaded by OLE

STDAPI DllCanUnloadNow(void)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    return (AfxDllCanUnloadNow()==S_OK && _Module.GetLockCount()==0) ? S_OK : S_FALSE;
}

/////////////////////////////////////////////////////////////////////////////
// Returns a class factory to create an object of the requested type

STDAPI DllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID* ppv)
{
    return _Module.GetClassObject(rclsid, riid, ppv);
}

/////////////////////////////////////////////////////////////////////////////
// DllRegisterServer - Adds entries to the system registry

STDAPI DllRegisterServer(void)
{
    // registers object, typelib and all interfaces in typelib
    return _Module.RegisterServer(TRUE);
}

/////////////////////////////////////////////////////////////////////////////
// DllUnregisterServer - Removes entries from the system registry

STDAPI DllUnregisterServer(void)
{
    return _Module.UnregisterServer(TRUE);
}


Examples - C++ Rounded Rectangle 2 Regen - RRectA.h

RRectA.h

C++ Rounded Rectangle 2 Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
/* this ALWAYS GENERATED file contains the definitions for the interfaces */

/* File created by MIDL compiler version 5.01.0164 */
/* at Mon Oct 19 16:31:05 1998
 */
/* Compiler settings for D:\tc60\SDK7.0\RRectA\RRectA.idl:
    Oicf (OptLev=i2), W1, Zp8, env=Win32, ms_ext, c_ext
    error checks: allocation ref bounds_check enum stub_data
*/
//@@MIDL_FILE_HEADING(  )

/* verify that the <rpcndr.h> version is high enough to compile this file*/
#ifndef __REQUIRED_RPCNDR_H_VERSION__
#define __REQUIRED_RPCNDR_H_VERSION__ 440
#endif

#include "rpc.h"
#include "rpcndr.h"

#ifndef __RPCNDR_H_VERSION__
#error this stub requires an updated version of <rpcndr.h>
#endif // __RPCNDR_H_VERSION__

#ifndef COM_NO_WINDOWS_H
#include "windows.h"
#include "ole2.h"
#endif /*COM_NO_WINDOWS_H*/

#ifndef __RRectA_h__
#define __RRectA_h__

#ifdef __cplusplus
extern "C"{
#endif

/* Forward Declarations */

#ifndef __IAutoRect_FWD_DEFINED__
#define __IAutoRect_FWD_DEFINED__
typedef interface IAutoRect IAutoRect;
#endif 	/* __IAutoRect_FWD_DEFINED__ */

#ifndef __AutoRect_FWD_DEFINED__
#define __AutoRect_FWD_DEFINED__

#ifdef __cplusplus
typedef class AutoRect AutoRect;
#else
typedef struct AutoRect AutoRect;
#endif /* __cplusplus */

#endif 	/* __AutoRect_FWD_DEFINED__ */

/* header files for imported files */
#include "oaidl.h"
#include "ocidl.h"

void __RPC_FAR * __RPC_USER MIDL_user_allocate(size_t);
void __RPC_USER MIDL_user_free( void __RPC_FAR * );

#ifndef __IAutoRect_INTERFACE_DEFINED__
#define __IAutoRect_INTERFACE_DEFINED__

/* interface IAutoRect */
/* [unique][helpstring][dual][uuid][object] */

EXTERN_C const IID IID_IAutoRect;

#if defined(__cplusplus) && !defined(CINTERFACE)

    MIDL_INTERFACE("45232FA1-65A2-11D2-8C4A-00403338C504")
    IAutoRect : public IDispatch
    {
    public:
        virtual /* [helpstring][id][propget] */ HRESULT STDMETHODCALLTYPE get_ClassID(
            /* [retval][out] */ BSTR __RPC_FAR *pVal) = 0;

        virtual /* [helpstring][id][propput] */ HRESULT STDMETHODCALLTYPE put_ClassID(
            /* [in] */ BSTR newVal) = 0;

        virtual /* [helpstring][id][propget] */ HRESULT STDMETHODCALLTYPE get_Description(
            /* [retval][out] */ BSTR __RPC_FAR *pVal) = 0;

        virtual /* [helpstring][id][propput] */ HRESULT STDMETHODCALLTYPE put_Description(
            /* [in] */ BSTR newVal) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE GetPropertyInfo(
            VARIANT __RPC_FAR *Names,
            VARIANT __RPC_FAR *Types,
            VARIANT __RPC_FAR *IDs,
            VARIANT __RPC_FAR *Defaults,
            /* [retval][out] */ long __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE GetPageInfo(
            IDispatch __RPC_FAR *AGraphic,
            long __RPC_FAR *StockPages,
            VARIANT __RPC_FAR *Names,
            /* [retval][out] */ long __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE GetWizardInfo(
            VARIANT __RPC_FAR *Names,
            /* [retval][out] */ long __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE GetEnumNames(
            long PropID,
            VARIANT __RPC_FAR *Names,
            VARIANT __RPC_FAR *Values,
            /* [retval][out] */ long __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE PageControls(
            IDispatch __RPC_FAR *ThisRegenMethod,
            IDispatch __RPC_FAR *AGraphic,
            long PageNumber,
            boolean SaveProperties,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE PageDone(
            IDispatch __RPC_FAR *ThisRegenMethod,
            VARIANT __RPC_FAR *PageNumber) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE PropertyPages(
            IDispatch __RPC_FAR *ThisRegenMethod,
            VARIANT __RPC_FAR *PageNumber,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE Wizard(
            IDispatch __RPC_FAR *ThisRegenMethod,
            VARIANT __RPC_FAR *WizardNumber,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE OnGeometryChanged(
            IDispatch __RPC_FAR *AGraphic,
            long GeomID,
            VARIANT __RPC_FAR *ParamOld,
            VARIANT __RPC_FAR *ParamNew) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE OnGeometryChanging(
            IDispatch __RPC_FAR *AGraphic,
            long GeomID,
            VARIANT __RPC_FAR *ParamOld,
            VARIANT __RPC_FAR *ParamNew,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE OnNewGraphic(
            IDispatch __RPC_FAR *CopyGraphic,
            boolean Copy,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE OnCopyGraphic(
            IDispatch __RPC_FAR *CopyGraphic,
            IDispatch __RPC_FAR *SourceGraphic,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE OnPropertyChanged(
            IDispatch __RPC_FAR *AGraphic,
            long PropID,
            VARIANT __RPC_FAR *ValueOld,
            VARIANT __RPC_FAR *ValueNew) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE OnPropertyChanging(
            IDispatch __RPC_FAR *AGraphic,
            long PropID,
            VARIANT __RPC_FAR *ValueOld,
            VARIANT __RPC_FAR *ValueNew,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE OnPropertyGet(
            IDispatch __RPC_FAR *AGraphic,
            long PropID) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE Draw(
            IDispatch __RPC_FAR *AGraphic,
            IDispatch __RPC_FAR *AView,
            VARIANT __RPC_FAR *AMatrix,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE Regen(
            IDispatch __RPC_FAR *AGraphic) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE Initialize(
            IDispatch __RPC_FAR *ThisRegenMethod,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

    };

#else 	/* C style interface */

    typedef struct IAutoRectVtbl
    {
        BEGIN_INTERFACE

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *QueryInterface )(
            IAutoRect __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [iid_is][out] */ void __RPC_FAR *__RPC_FAR *ppvObject);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *AddRef )(
            IAutoRect __RPC_FAR * This);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *Release )(
            IAutoRect __RPC_FAR * This);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetTypeInfoCount )(
            IAutoRect __RPC_FAR * This,
            /* [out] */ UINT __RPC_FAR *pctinfo);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetTypeInfo )(
            IAutoRect __RPC_FAR * This,
            /* [in] */ UINT iTInfo,
            /* [in] */ LCID lcid,
            /* [out] */ ITypeInfo __RPC_FAR *__RPC_FAR *ppTInfo);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetIDsOfNames )(
            IAutoRect __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [size_is][in] */ LPOLESTR __RPC_FAR *rgszNames,
            /* [in] */ UINT cNames,
            /* [in] */ LCID lcid,
            /* [size_is][out] */ DISPID __RPC_FAR *rgDispId);

        /* [local] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Invoke )(
            IAutoRect __RPC_FAR * This,
            /* [in] */ DISPID dispIdMember,
            /* [in] */ REFIID riid,
            /* [in] */ LCID lcid,
            /* [in] */ WORD wFlags,
            /* [out][in] */ DISPPARAMS __RPC_FAR *pDispParams,
            /* [out] */ VARIANT __RPC_FAR *pVarResult,
            /* [out] */ EXCEPINFO __RPC_FAR *pExcepInfo,
            /* [out] */ UINT __RPC_FAR *puArgErr);

        /* [helpstring][id][propget] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *get_ClassID )(
            IAutoRect __RPC_FAR * This,
            /* [retval][out] */ BSTR __RPC_FAR *pVal);

        /* [helpstring][id][propput] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *put_ClassID )(
            IAutoRect __RPC_FAR * This,
            /* [in] */ BSTR newVal);

        /* [helpstring][id][propget] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *get_Description )(
            IAutoRect __RPC_FAR * This,
            /* [retval][out] */ BSTR __RPC_FAR *pVal);

        /* [helpstring][id][propput] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *put_Description )(
            IAutoRect __RPC_FAR * This,
            /* [in] */ BSTR newVal);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetPropertyInfo )(
            IAutoRect __RPC_FAR * This,
            VARIANT __RPC_FAR *Names,
            VARIANT __RPC_FAR *Types,
            VARIANT __RPC_FAR *IDs,
            VARIANT __RPC_FAR *Defaults,
            /* [retval][out] */ long __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetPageInfo )(
            IAutoRect __RPC_FAR * This,
            IDispatch __RPC_FAR *AGraphic,
            long __RPC_FAR *StockPages,
            VARIANT __RPC_FAR *Names,
            /* [retval][out] */ long __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetWizardInfo )(
            IAutoRect __RPC_FAR * This,
            VARIANT __RPC_FAR *Names,
            /* [retval][out] */ long __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetEnumNames )(
            IAutoRect __RPC_FAR * This,
            long PropID,
            VARIANT __RPC_FAR *Names,
            VARIANT __RPC_FAR *Values,
            /* [retval][out] */ long __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *PageControls )(
            IAutoRect __RPC_FAR * This,
            IDispatch __RPC_FAR *ThisRegenMethod,
            IDispatch __RPC_FAR *AGraphic,
            long PageNumber,
            boolean SaveProperties,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *PageDone )(
            IAutoRect __RPC_FAR * This,
            IDispatch __RPC_FAR *ThisRegenMethod,
            VARIANT __RPC_FAR *PageNumber);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *PropertyPages )(
            IAutoRect __RPC_FAR * This,
            IDispatch __RPC_FAR *ThisRegenMethod,
            VARIANT __RPC_FAR *PageNumber,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Wizard )(
            IAutoRect __RPC_FAR * This,
            IDispatch __RPC_FAR *ThisRegenMethod,
            VARIANT __RPC_FAR *WizardNumber,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *OnGeometryChanged )(
            IAutoRect __RPC_FAR * This,
            IDispatch __RPC_FAR *AGraphic,
            long GeomID,
            VARIANT __RPC_FAR *ParamOld,
            VARIANT __RPC_FAR *ParamNew);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *OnGeometryChanging )(
            IAutoRect __RPC_FAR * This,
            IDispatch __RPC_FAR *AGraphic,
            long GeomID,
            VARIANT __RPC_FAR *ParamOld,
            VARIANT __RPC_FAR *ParamNew,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *OnNewGraphic )(
            IAutoRect __RPC_FAR * This,
            IDispatch __RPC_FAR *CopyGraphic,
            boolean Copy,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *OnCopyGraphic )(
            IAutoRect __RPC_FAR * This,
            IDispatch __RPC_FAR *CopyGraphic,
            IDispatch __RPC_FAR *SourceGraphic,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *OnPropertyChanged )(
            IAutoRect __RPC_FAR * This,
            IDispatch __RPC_FAR *AGraphic,
            long PropID,
            VARIANT __RPC_FAR *ValueOld,
            VARIANT __RPC_FAR *ValueNew);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *OnPropertyChanging )(
            IAutoRect __RPC_FAR * This,
            IDispatch __RPC_FAR *AGraphic,
            long PropID,
            VARIANT __RPC_FAR *ValueOld,
            VARIANT __RPC_FAR *ValueNew,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *OnPropertyGet )(
            IAutoRect __RPC_FAR * This,
            IDispatch __RPC_FAR *AGraphic,
            long PropID);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Draw )(
            IAutoRect __RPC_FAR * This,
            IDispatch __RPC_FAR *AGraphic,
            IDispatch __RPC_FAR *AView,
            VARIANT __RPC_FAR *AMatrix,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Regen )(
            IAutoRect __RPC_FAR * This,
            IDispatch __RPC_FAR *AGraphic);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Initialize )(
            IAutoRect __RPC_FAR * This,
            IDispatch __RPC_FAR *ThisRegenMethod,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        END_INTERFACE
    } IAutoRectVtbl;

    interface IAutoRect
    {
        CONST_VTBL struct IAutoRectVtbl __RPC_FAR *lpVtbl;
    };

#ifdef COBJMACROS

#define IAutoRect_QueryInterface(This,riid,ppvObject)	\
    (This)->lpVtbl -> QueryInterface(This,riid,ppvObject)

#define IAutoRect_AddRef(This)	\
    (This)->lpVtbl -> AddRef(This)

#define IAutoRect_Release(This)	\
    (This)->lpVtbl -> Release(This)

#define IAutoRect_GetTypeInfoCount(This,pctinfo)	\
    (This)->lpVtbl -> GetTypeInfoCount(This,pctinfo)

#define IAutoRect_GetTypeInfo(This,iTInfo,lcid,ppTInfo)	\
    (This)->lpVtbl -> GetTypeInfo(This,iTInfo,lcid,ppTInfo)

#define IAutoRect_GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)	\
    (This)->lpVtbl -> GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)

#define IAutoRect_Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)	\
    (This)->lpVtbl -> Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)

#define IAutoRect_get_ClassID(This,pVal)	\
    (This)->lpVtbl -> get_ClassID(This,pVal)

#define IAutoRect_put_ClassID(This,newVal)	\
    (This)->lpVtbl -> put_ClassID(This,newVal)

#define IAutoRect_get_Description(This,pVal)	\
    (This)->lpVtbl -> get_Description(This,pVal)

#define IAutoRect_put_Description(This,newVal)	\
    (This)->lpVtbl -> put_Description(This,newVal)

#define IAutoRect_GetPropertyInfo(This,Names,Types,IDs,Defaults,ret)	\
    (This)->lpVtbl -> GetPropertyInfo(This,Names,Types,IDs,Defaults,ret)

#define IAutoRect_GetPageInfo(This,AGraphic,StockPages,Names,ret)	\
    (This)->lpVtbl -> GetPageInfo(This,AGraphic,StockPages,Names,ret)

#define IAutoRect_GetWizardInfo(This,Names,ret)	\
    (This)->lpVtbl -> GetWizardInfo(This,Names,ret)

#define IAutoRect_GetEnumNames(This,PropID,Names,Values,ret)	\
    (This)->lpVtbl -> GetEnumNames(This,PropID,Names,Values,ret)

#define IAutoRect_PageControls(This,ThisRegenMethod,AGraphic,PageNumber,SaveProperties,ret)	\
    (This)->lpVtbl -> PageControls(This,ThisRegenMethod,AGraphic,PageNumber,SaveProperties,ret)

#define IAutoRect_PageDone(This,ThisRegenMethod,PageNumber)	\
    (This)->lpVtbl -> PageDone(This,ThisRegenMethod,PageNumber)

#define IAutoRect_PropertyPages(This,ThisRegenMethod,PageNumber,ret)	\
    (This)->lpVtbl -> PropertyPages(This,ThisRegenMethod,PageNumber,ret)

#define IAutoRect_Wizard(This,ThisRegenMethod,WizardNumber,ret)	\
    (This)->lpVtbl -> Wizard(This,ThisRegenMethod,WizardNumber,ret)

#define IAutoRect_OnGeometryChanged(This,AGraphic,GeomID,ParamOld,ParamNew)	\
    (This)->lpVtbl -> OnGeometryChanged(This,AGraphic,GeomID,ParamOld,ParamNew)

#define IAutoRect_OnGeometryChanging(This,AGraphic,GeomID,ParamOld,ParamNew,ret)	\
    (This)->lpVtbl -> OnGeometryChanging(This,AGraphic,GeomID,ParamOld,ParamNew,ret)

#define IAutoRect_OnNewGraphic(This,CopyGraphic,Copy,ret)	\
    (This)->lpVtbl -> OnNewGraphic(This,CopyGraphic,Copy,ret)

#define IAutoRect_OnCopyGraphic(This,CopyGraphic,SourceGraphic,ret)	\
    (This)->lpVtbl -> OnCopyGraphic(This,CopyGraphic,SourceGraphic,ret)

#define IAutoRect_OnPropertyChanged(This,AGraphic,PropID,ValueOld,ValueNew)	\
    (This)->lpVtbl -> OnPropertyChanged(This,AGraphic,PropID,ValueOld,ValueNew)

#define IAutoRect_OnPropertyChanging(This,AGraphic,PropID,ValueOld,ValueNew,ret)	\
    (This)->lpVtbl -> OnPropertyChanging(This,AGraphic,PropID,ValueOld,ValueNew,ret)

#define IAutoRect_OnPropertyGet(This,AGraphic,PropID)	\
    (This)->lpVtbl -> OnPropertyGet(This,AGraphic,PropID)

#define IAutoRect_Draw(This,AGraphic,AView,AMatrix,ret)	\
    (This)->lpVtbl -> Draw(This,AGraphic,AView,AMatrix,ret)

#define IAutoRect_Regen(This,AGraphic)	\
    (This)->lpVtbl -> Regen(This,AGraphic)

#define IAutoRect_Initialize(This,ThisRegenMethod,ret)	\
    (This)->lpVtbl -> Initialize(This,ThisRegenMethod,ret)

#endif /* COBJMACROS */

#endif 	/* C style interface */

/* [helpstring][id][propget] */ HRESULT STDMETHODCALLTYPE IAutoRect_get_ClassID_Proxy(
    IAutoRect __RPC_FAR * This,
    /* [retval][out] */ BSTR __RPC_FAR *pVal);

void __RPC_STUB IAutoRect_get_ClassID_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id][propput] */ HRESULT STDMETHODCALLTYPE IAutoRect_put_ClassID_Proxy(
    IAutoRect __RPC_FAR * This,
    /* [in] */ BSTR newVal);

void __RPC_STUB IAutoRect_put_ClassID_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id][propget] */ HRESULT STDMETHODCALLTYPE IAutoRect_get_Description_Proxy(
    IAutoRect __RPC_FAR * This,
    /* [retval][out] */ BSTR __RPC_FAR *pVal);

void __RPC_STUB IAutoRect_get_Description_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id][propput] */ HRESULT STDMETHODCALLTYPE IAutoRect_put_Description_Proxy(
    IAutoRect __RPC_FAR * This,
    /* [in] */ BSTR newVal);

void __RPC_STUB IAutoRect_put_Description_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_GetPropertyInfo_Proxy(
    IAutoRect __RPC_FAR * This,
    VARIANT __RPC_FAR *Names,
    VARIANT __RPC_FAR *Types,
    VARIANT __RPC_FAR *IDs,
    VARIANT __RPC_FAR *Defaults,
    /* [retval][out] */ long __RPC_FAR *ret);

void __RPC_STUB IAutoRect_GetPropertyInfo_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_GetPageInfo_Proxy(
    IAutoRect __RPC_FAR * This,
    IDispatch __RPC_FAR *AGraphic,
    long __RPC_FAR *StockPages,
    VARIANT __RPC_FAR *Names,
    /* [retval][out] */ long __RPC_FAR *ret);

void __RPC_STUB IAutoRect_GetPageInfo_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_GetWizardInfo_Proxy(
    IAutoRect __RPC_FAR * This,
    VARIANT __RPC_FAR *Names,
    /* [retval][out] */ long __RPC_FAR *ret);

void __RPC_STUB IAutoRect_GetWizardInfo_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_GetEnumNames_Proxy(
    IAutoRect __RPC_FAR * This,
    long PropID,
    VARIANT __RPC_FAR *Names,
    VARIANT __RPC_FAR *Values,
    /* [retval][out] */ long __RPC_FAR *ret);

void __RPC_STUB IAutoRect_GetEnumNames_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_PageControls_Proxy(
    IAutoRect __RPC_FAR * This,
    IDispatch __RPC_FAR *ThisRegenMethod,
    IDispatch __RPC_FAR *AGraphic,
    long PageNumber,
    boolean SaveProperties,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IAutoRect_PageControls_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_PageDone_Proxy(
    IAutoRect __RPC_FAR * This,
    IDispatch __RPC_FAR *ThisRegenMethod,
    VARIANT __RPC_FAR *PageNumber);

void __RPC_STUB IAutoRect_PageDone_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_PropertyPages_Proxy(
    IAutoRect __RPC_FAR * This,
    IDispatch __RPC_FAR *ThisRegenMethod,
    VARIANT __RPC_FAR *PageNumber,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IAutoRect_PropertyPages_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_Wizard_Proxy(
    IAutoRect __RPC_FAR * This,
    IDispatch __RPC_FAR *ThisRegenMethod,
    VARIANT __RPC_FAR *WizardNumber,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IAutoRect_Wizard_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_OnGeometryChanged_Proxy(
    IAutoRect __RPC_FAR * This,
    IDispatch __RPC_FAR *AGraphic,
    long GeomID,
    VARIANT __RPC_FAR *ParamOld,
    VARIANT __RPC_FAR *ParamNew);

void __RPC_STUB IAutoRect_OnGeometryChanged_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_OnGeometryChanging_Proxy(
    IAutoRect __RPC_FAR * This,
    IDispatch __RPC_FAR *AGraphic,
    long GeomID,
    VARIANT __RPC_FAR *ParamOld,
    VARIANT __RPC_FAR *ParamNew,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IAutoRect_OnGeometryChanging_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_OnNewGraphic_Proxy(
    IAutoRect __RPC_FAR * This,
    IDispatch __RPC_FAR *CopyGraphic,
    boolean Copy,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IAutoRect_OnNewGraphic_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_OnCopyGraphic_Proxy(
    IAutoRect __RPC_FAR * This,
    IDispatch __RPC_FAR *CopyGraphic,
    IDispatch __RPC_FAR *SourceGraphic,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IAutoRect_OnCopyGraphic_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_OnPropertyChanged_Proxy(
    IAutoRect __RPC_FAR * This,
    IDispatch __RPC_FAR *AGraphic,
    long PropID,
    VARIANT __RPC_FAR *ValueOld,
    VARIANT __RPC_FAR *ValueNew);

void __RPC_STUB IAutoRect_OnPropertyChanged_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_OnPropertyChanging_Proxy(
    IAutoRect __RPC_FAR * This,
    IDispatch __RPC_FAR *AGraphic,
    long PropID,
    VARIANT __RPC_FAR *ValueOld,
    VARIANT __RPC_FAR *ValueNew,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IAutoRect_OnPropertyChanging_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_OnPropertyGet_Proxy(
    IAutoRect __RPC_FAR * This,
    IDispatch __RPC_FAR *AGraphic,
    long PropID);

void __RPC_STUB IAutoRect_OnPropertyGet_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_Draw_Proxy(
    IAutoRect __RPC_FAR * This,
    IDispatch __RPC_FAR *AGraphic,
    IDispatch __RPC_FAR *AView,
    VARIANT __RPC_FAR *AMatrix,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IAutoRect_Draw_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_Regen_Proxy(
    IAutoRect __RPC_FAR * This,
    IDispatch __RPC_FAR *AGraphic);

void __RPC_STUB IAutoRect_Regen_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IAutoRect_Initialize_Proxy(
    IAutoRect __RPC_FAR * This,
    IDispatch __RPC_FAR *ThisRegenMethod,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IAutoRect_Initialize_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

#endif 	/* __IAutoRect_INTERFACE_DEFINED__ */

#ifndef __RRECTALib_LIBRARY_DEFINED__
#define __RRECTALib_LIBRARY_DEFINED__

/* library RRECTALib */
/* [helpstring][version][uuid] */

EXTERN_C const IID LIBID_RRECTALib;

EXTERN_C const CLSID CLSID_AutoRect;

#ifdef __cplusplus

class DECLSPEC_UUID("45232FA2-65A2-11D2-8C4A-00403338C504")
AutoRect;
#endif
#endif /* __RRECTALib_LIBRARY_DEFINED__ */

/* Additional Prototypes for ALL interfaces */

unsigned long             __RPC_USER  BSTR_UserSize(     unsigned long __RPC_FAR *, unsigned long            , BSTR __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  BSTR_UserMarshal(  unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, BSTR __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  BSTR_UserUnmarshal(unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, BSTR __RPC_FAR * );
void                      __RPC_USER  BSTR_UserFree(     unsigned long __RPC_FAR *, BSTR __RPC_FAR * );

unsigned long             __RPC_USER  VARIANT_UserSize(     unsigned long __RPC_FAR *, unsigned long            , VARIANT __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  VARIANT_UserMarshal(  unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, VARIANT __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  VARIANT_UserUnmarshal(unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, VARIANT __RPC_FAR * );
void                      __RPC_USER  VARIANT_UserFree(     unsigned long __RPC_FAR *, VARIANT __RPC_FAR * );

/* end of Additional Prototypes */

#ifdef __cplusplus
}
#endif

#endif


Examples - C++ Spline Regen - AutoSpl.cpp

AutoSpl.cpp

C++ Spline Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// AutoSpl.cpp : implementation file
//

#include "stdafx.h"
#include "MfcSplin.h"
#include "AutoSpl.h"  // This class
#include "SplPage.h"  // Property page class
#include "GxIntf.h"   // TurboCAD interfaces (forward declarations)
#include "Imsigx.h"   // TurboCAD interfaces

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

// Standard variants
COleVariant t(-1L, VT_BOOL);
COleVariant f(0L, VT_BOOL);
COleVariant missing((long)DISP_E_PARAMNOTFOUND, VT_ERROR);

/////////////////////////////////////////////////////////////////////////////
// CAutoSpline

const IID IID_IGraphic =
    {0x6A481109,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

IMPLEMENT_DYNCREATE(CAutoSpline, CCmdTarget)

CAutoSpline::CAutoSpline() :
    m_pSplinePage(NULL)
{
    EnableAutomation();

    // To keep the application running as long as an OLE automation
    //	object is active, the constructor calls AfxOleLockApp.

    AfxOleLockApp();
}

CAutoSpline::~CAutoSpline()
{
    // To terminate the application when all objects created with
    // 	with OLE automation, the destructor calls AfxOleUnlockApp.

    AfxOleUnlockApp();
}

void CAutoSpline::OnFinalRelease()
{
    // When the last reference for an automation object is released
    // OnFinalRelease is called.  The base class will automatically
    // deletes the object.  Add additional cleanup required for your
    // object before calling the base class.

    CCmdTarget::OnFinalRelease();
}

BEGIN_MESSAGE_MAP(CAutoSpline, CCmdTarget)
    //{{AFX_MSG_MAP(CAutoSpline)
        // NOTE - the ClassWizard will add and remove mapping macros here.
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

BEGIN_DISPATCH_MAP(CAutoSpline, CCmdTarget)
    //{{AFX_DISPATCH_MAP(CAutoSpline)
    DISP_PROPERTY_EX(CAutoSpline, "ClassID", GetClassID, SetNotSupported, VT_BSTR)
    DISP_PROPERTY_EX(CAutoSpline, "Description", GetDescription, SetNotSupported, VT_BSTR)
    DISP_FUNCTION(CAutoSpline, "GetPropertyInfo", GetPropertyInfo, VT_I4, VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT VTS_PVARIANT)
    DISP_FUNCTION(CAutoSpline, "GetPageInfo", GetPageInfo, VT_I4, VTS_DISPATCH VTS_PI4 VTS_PVARIANT)
    DISP_FUNCTION(CAutoSpline, "GetWizardInfo", GetWizardInfo, VT_I4, VTS_PVARIANT)
    DISP_FUNCTION(CAutoSpline, "GetEnumNames", GetEnumNames, VT_I4, VTS_I4 VTS_PVARIANT VTS_PVARIANT)
    DISP_FUNCTION(CAutoSpline, "PageControls", PageControls, VT_BOOL, VTS_DISPATCH VTS_DISPATCH VTS_I4 VTS_BOOL)
    DISP_FUNCTION(CAutoSpline, "PageDone", PageDone, VT_EMPTY, VTS_DISPATCH VTS_PVARIANT)
    DISP_FUNCTION(CAutoSpline, "PropertyPages", PropertyPages, VT_BOOL, VTS_DISPATCH VTS_PVARIANT)
    DISP_FUNCTION(CAutoSpline, "Wizard", Wizard, VT_BOOL, VTS_DISPATCH VTS_PVARIANT)
    DISP_FUNCTION(CAutoSpline, "OnGeometryChanged", OnGeometryChanged, VT_EMPTY, VTS_DISPATCH VTS_I4 VTS_PVARIANT VTS_PVARIANT)
    DISP_FUNCTION(CAutoSpline, "OnGeometryChanging", OnGeometryChanging, VT_BOOL, VTS_DISPATCH VTS_I4 VTS_PVARIANT VTS_PVARIANT)
    DISP_FUNCTION(CAutoSpline, "OnNewGraphic", OnNewGraphic, VT_BOOL, VTS_DISPATCH VTS_BOOL)
    DISP_FUNCTION(CAutoSpline, "OnCopyGraphic", OnCopyGraphic, VT_BOOL, VTS_DISPATCH VTS_DISPATCH)
    DISP_FUNCTION(CAutoSpline, "OnPropertyChanged", OnPropertyChanged, VT_EMPTY, VTS_DISPATCH VTS_I4 VTS_PVARIANT VTS_PVARIANT)
    DISP_FUNCTION(CAutoSpline, "OnPropertyChanging", OnPropertyChanging, VT_BOOL, VTS_DISPATCH VTS_I4 VTS_PVARIANT VTS_PVARIANT)
    DISP_FUNCTION(CAutoSpline, "OnPropertyGet", OnPropertyGet, VT_EMPTY, VTS_DISPATCH VTS_I4)
    DISP_FUNCTION(CAutoSpline, "Draw", Draw, VT_BOOL, VTS_DISPATCH VTS_DISPATCH VTS_PVARIANT)
    DISP_FUNCTION(CAutoSpline, "Regen", Regen, VT_EMPTY, VTS_DISPATCH)
    DISP_FUNCTION(CAutoSpline, "Initialize", Initialize, VT_BOOL, VTS_DISPATCH)
    //}}AFX_DISPATCH_MAP
END_DISPATCH_MAP()

// Note: we add support for IID_ISmartObjectServer to support typesafe binding
//  from VBA.  This IID must match the GUID that is attached to the
//  dispinterface in the .ODL file.

// {6A481303-E531-11CF-A115-00A024158DAF}
static const IID IID_ISmartObjectServer =
{0x6A481303,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

BEGIN_INTERFACE_MAP(CAutoSpline, CCmdTarget)
    INTERFACE_PART(CAutoSpline, IID_ISmartObjectServer, Dispatch)
END_INTERFACE_MAP()

// {7724BB46-B671-11D0-9B3B-444553540000}
IMPLEMENT_OLECREATE(CAutoSpline, "MFCSpline.Spline", 0x7724bb46, 0xb671, 0x11d0, 0x9b, 0x3b, 0x44, 0x45, 0x53, 0x54, 0x0, 0x0);

/////////////////////////////////////////////////////////////////////////////
// CAutoSpline message handlers

BSTR CAutoSpline::GetDescription()
{
    // Get the description from the resource
    CString strResult;
    strResult.LoadString(IDS_AUTOSPLINE_DESCRIPTION);

    return strResult.AllocSysString();
}

BSTR CAutoSpline::GetClassID()
{
    // Convert our GUID (see IMPLEMENT_OLECREATE macro) to a string
    LPOLESTR olestr;
    HRESULT hRes = ::StringFromCLSID(guid, &olestr);
    if (FAILED(hRes))
        return NULL;

    BSTR bstr = ::SysAllocString(olestr);
    CoTaskMemFree(olestr);
    return bstr;
}

const long VT_INTEGER_ENUM = VT_I2 + 100;
const long VT_LONG_ENUM = VT_I4 + 100;
const long VT_STRING_ENUM = VT_BSTR + 100;

const long nProperties = 6;

enum PropertyIDs
{
   idSplineType = 1,
   idSegments = 2,
   idShowFrame = 3,
   idShowControlPoints = 4,
   idSmoothing = 5,
   idFrameColor = 6
};

enum SplineTypes
{
    typeCubicSpline = 0
};

long CAutoSpline::GetPropertyInfo(VARIANT FAR* Names, VARIANT FAR* Types, VARIANT FAR* IDs, VARIANT FAR* Defaults)
{
     ASSERT(Names->vt == VT_ARRAY|VT_BSTR);
    ASSERT(Types->vt == VT_ARRAY|VT_I4);
    ASSERT(IDs->vt == VT_ARRAY|VT_I4);
    ASSERT(Defaults->vt == VT_ARRAY|VT_VARIANT);

     SAFEARRAYBOUND bound = { nProperties, 0 };
    if (FAILED(::SafeArrayRedim(Names->parray, &bound)))
        return 0;
    if (FAILED(::SafeArrayRedim(Types->parray, &bound)))
        return 0;
    if (FAILED(::SafeArrayRedim(IDs->parray, &bound)))
        return 0;
    if (FAILED(::SafeArrayRedim(Defaults->parray, &bound)))
        return 0;

    BSTR* rgNames;
    long* rgTypes;
    long* rgIDs;
    VARIANT* rgDefaults;
    long lReturn = 0;
    if (SUCCEEDED(::SafeArrayAccessData(Names->parray, (void**)&rgNames)))
    {
        if (SUCCEEDED(::SafeArrayAccessData(Types->parray, (void**)&rgTypes)))
        {
            if (SUCCEEDED(::SafeArrayAccessData(IDs->parray, (void**)&rgIDs)))
            {
                if (SUCCEEDED(::SafeArrayAccessData(Defaults->parray, (void**)&rgDefaults)))
                {
                    rgNames[0] = ::SysAllocString(OLESTR("SplineType"));
                    rgTypes[0] = VT_INTEGER_ENUM;
                    rgIDs[0] = idSplineType;
                    rgDefaults[0].vt = VT_I2;
                    rgDefaults[0].iVal = typeCubicSpline;

                    rgNames[1] = ::SysAllocString(OLESTR("Segments"));
                    rgTypes[1] = VT_I4;
                    rgIDs[1] = idSegments;
                    rgDefaults[1].vt = VT_I4;
                    rgDefaults[1].lVal = 16;

                    rgNames[2] = ::SysAllocString(OLESTR("ShowFrame"));
                    rgTypes[2] = VT_BOOL;
                    rgIDs[2] = idShowFrame;
                    rgDefaults[2].vt = VT_BOOL;
                    rgDefaults[2].boolVal = FALSE;

                    rgNames[3] = ::SysAllocString(OLESTR("ShowControlPoints"));
                    rgTypes[3] = VT_BOOL;
                    rgIDs[3] = idShowControlPoints;
                    rgDefaults[3].vt = VT_BOOL;
                    rgDefaults[3].boolVal = FALSE;

                    rgNames[4] = ::SysAllocString(OLESTR("Smoothing"));
                    rgTypes[4] = VT_BOOL;
                    rgIDs[4] = idSmoothing;
                    rgDefaults[4].vt = VT_BOOL;
                    rgDefaults[4].boolVal = FALSE;

                    rgNames[5] = ::SysAllocString(OLESTR("FrameColor"));
                    rgTypes[5] = VT_I4;
                    rgIDs[5] = idFrameColor;
                    rgDefaults[5].vt = VT_I4;
                    rgDefaults[5].lVal = RGB(255, 0, 0);

                    ::SafeArrayUnaccessData(Defaults->parray);
                    lReturn = nProperties;
                }
                ::SafeArrayUnaccessData(IDs->parray);
            }
            ::SafeArrayUnaccessData(Types->parray);
        }
        ::SafeArrayUnaccessData(Names->parray);
    }
    return lReturn;
}

enum StockPages {
    PP_STOCK_PEN = 1,
    PP_STOCK_BRUSH = 2,
    PP_STOCK_TEXT = 4,
    PP_STOCK_INSERT = 8,
    PP_STOCK_VIEWPORT = 16,
    PP_STOCK_AUTO = 32
};

long CAutoSpline::GetPageInfo(LPDISPATCH /*AGraphic*/, long* StockPages, VARIANT FAR* Names)
{
    ASSERT(StockPages != NULL);
     ASSERT(Names->vt == VT_ARRAY|VT_BSTR);

    // Request pen page and auto page
    *StockPages = PP_STOCK_PEN | PP_STOCK_AUTO;

     SAFEARRAYBOUND bound = { 1, 0 };
    if (FAILED(::SafeArrayRedim(Names->parray, &bound)))
        return 0;

    CString strCaption;
    strCaption.LoadString(IDS_AUTOSPLINE_CAPTION);
    BSTR bstrCaption = strCaption.AllocSysString();

    long lIndex = 0;
    if (FAILED(SafeArrayPutElement(Names->parray, &lIndex, (void*)bstrCaption)))
    {
        ::SysFreeString(bstrCaption);
        return 0;
    }
    return 1;
}

long CAutoSpline::GetWizardInfo(VARIANT FAR* Names)
{
    // No wizards, nothing to do
    return 0;
}

long CAutoSpline::GetEnumNames(long PropID, VARIANT FAR* Names, VARIANT FAR* Values)
{
    if (PropID != idSplineType)
        return 0;

     ASSERT(Names->vt == VT_ARRAY|VT_BSTR);
     ASSERT(Values->vt == VT_ARRAY|VT_VARIANT);

    // TODO: Associate each spline type name and value
    return 0;
}

BOOL CAutoSpline::PageControls(LPDISPATCH ThisRegenMethod, LPDISPATCH AGraphic, long PageNumber, BOOL SaveProperties)
{
    IGraphic* pIGraphic = NULL;
    if (FAILED(AGraphic->QueryInterface(IID_IGraphic, (void**)&pIGraphic)))
        return FALSE;

    BOOL bReturn = FALSE;
    Properties* pProps = NULL;
    Property* pProp;
    COleVariant varIndex, varValue;
    if (SUCCEEDED(pIGraphic->get_Properties(&pProps)))
    {
        if (SaveProperties)
        {
            if (m_pSplinePage != NULL)
            {
                // Note: the following can fail (for non-spline graphics)
                varIndex = "Segments";
                if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
                {
                    varValue = (const long)m_pSplinePage->m_nSegments;
                    pProp->put_Value(0, &varValue);
                    pProp->Release();
                    varValue.Clear();
                }
                varIndex = "ShowControlPoints";
                if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
                {
                    // MFC has no overloaded operator for BOOLs!
                    varValue.vt = VT_BOOL;
                    varValue.boolVal = m_pSplinePage->m_bControlPoints;
                    pProp->put_Value(0, &varValue);
                    pProp->Release();
                    varValue.Clear();
                }
                varIndex = "ShowFrame";
                if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
                {
                    varValue.vt = VT_BOOL;
                    varValue.boolVal = m_pSplinePage->m_bFrame;
                    pProp->put_Value(0, &varValue);
                    pProp->Release();
                    varValue.Clear();
                }
                varIndex = "Smoothing";
                if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
                {
                    varValue.vt = VT_BOOL;
                    varValue.boolVal = m_pSplinePage->m_bSmoothing;
                    pProp->put_Value(0, &varValue);
                    pProp->Release();
                    varValue.Clear();
                }
                bReturn = TRUE;
            }
        }
        else
        {
            ASSERT(m_pSplinePage == NULL);
            m_pSplinePage = new CSplinePage();

            // Note: the following can fail (for indeterminate values)
            varIndex = "Segments";
            if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
            {
                if (SUCCEEDED(pProp->get_Value(0, &varValue)) &&
                    varValue.vt == VT_I4)
                    m_pSplinePage->m_nSegments = varValue.lVal;
                pProp->Release();
                varValue.Clear();
            }
            varIndex = "ShowControlPoints";
            if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
            {
                if (SUCCEEDED(pProp->get_Value(0, &varValue)) &&
                    varValue.vt == VT_BOOL)
                    m_pSplinePage->m_bControlPoints = varValue.boolVal;
                pProp->Release();
                varValue.Clear();
            }
            varIndex = "ShowFrame";
            if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
            {
                if (SUCCEEDED(pProp->get_Value(0, &varValue)) &&
                    varValue.vt == VT_BOOL)
                    m_pSplinePage->m_bFrame = varValue.boolVal;
                pProp->Release();
                varValue.Clear();
            }
            varIndex = "Smoothing";
            if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
            {
                if (SUCCEEDED(pProp->get_Value(0, &varValue)) &&
                    varValue.vt == VT_BOOL)
                    m_pSplinePage->m_bSmoothing = varValue.boolVal;
                pProp->Release();
                varValue.Clear();
            }
            bReturn = TRUE;
        }
        pProps->Release();
    }

    pIGraphic->Release();
    return bReturn;
}

void CAutoSpline::PageDone(LPDISPATCH ThisRegenMethod, VARIANT FAR* PageNumber)
{
    // We're finished with the page
    delete m_pSplinePage;
    m_pSplinePage = NULL;
}

BOOL CAutoSpline::PropertyPages(LPDISPATCH ThisRegenMethod, VARIANT FAR* PageNumber)
{
    if (m_pSplinePage == NULL)
        return FALSE;

    // Run the dialog and get the results
    int nResult = m_pSplinePage->DoModal();
    return (nResult == IDOK);
}

BOOL CAutoSpline::Wizard(LPDISPATCH ThisRegenMethod, VARIANT FAR* WizardNumber)
{
    // No wizards, so just return FALSE.
    return FALSE;
}

void CAutoSpline::OnGeometryChanged(LPDISPATCH AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew)
{
}

BOOL CAutoSpline::OnGeometryChanging(LPDISPATCH AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew)
{
    // OK to change our geometry, so just return TRUE.
    return TRUE;
}

BOOL CAutoSpline::OnNewGraphic(LPDISPATCH AGraphic, BOOL Copy)
{
    // Return FALSE on failure.
    // For copies, usually do nothing.
    if (Copy)
        return TRUE;

    // Add vertices, etc. for new graphic here.

    // TODO: Do nothing here.
    IGraphic* pIGraphic = NULL;
    if (FAILED(AGraphic->QueryInterface(IID_IGraphic, (void**)&pIGraphic)))
        return FALSE;

    Vertices* pVerts = NULL;
    IVertex* pIVertex = NULL;

    if (SUCCEEDED(pIGraphic->get_Vertices(&pVerts)))
    {
        COleVariant x;
        COleVariant y;
        COleVariant z(0.0);

        BOOL bFirst = TRUE;
        const double points[4*2] = { 0.0, 0.0, 1.0, 1.0, 2.0, 1.0, 3.0, 0.0 };
        for (int i = 0; i < 4*2; )
        {
            x = points[i++];
            y = points[i++];
            if (SUCCEEDED(pVerts->Add(&x, &y, &z,
                bFirst ? &f : &t /*penDown*/,
                &t /*selectable*/,
                &t /*snappable*/,
                &t /*editable*/,
                &t /*linkable*/,
                &f /*calculated*/,
                &missing /*before*/,
                &missing /*after*/,
                &pIVertex)))
                pIVertex->Release();
            bFirst = FALSE;
        }
    }
    pIGraphic->Release();
    return TRUE;
}

BOOL CAutoSpline::OnCopyGraphic(LPDISPATCH DestGraphic, LPDISPATCH SourceGraphic)
{
    // Return FALSE on failure.
    return TRUE;
}

void CAutoSpline::OnPropertyChanged(LPDISPATCH AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew)
{
}

BOOL CAutoSpline::OnPropertyChanging(LPDISPATCH AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew)
{
    // OK to change all of our properties, so just return TRUE.
    return TRUE;
}

void CAutoSpline::OnPropertyGet(LPDISPATCH AGraphic, long PropID)
{
    // No special recalculating of properties needed.
}

BOOL CAutoSpline::Draw(LPDISPATCH AGraphic, LPDISPATCH AView, VARIANT FAR* AMatrix)
{
    // We don't handle special drawing, so just return FALSE.
    return FALSE;
}

BOOL GetVertexXYZ(IGraphic* pIGraphic, const long lVertex, double& x, double& y, double& z)
{
    IVertex* pIVertex = NULL;
    Vertices* pVerts = NULL;
    BOOL bSuccess = FALSE;
    if (SUCCEEDED(pIGraphic->get_Vertices(&pVerts)))
    {
        COleVariant varIndex = lVertex;
        if (SUCCEEDED(pVerts->get_Item(&varIndex, &pIVertex)))
        {
            if (SUCCEEDED(pIVertex->get_X(&x)) &&
                SUCCEEDED(pIVertex->get_Y(&y)) &&
                SUCCEEDED(pIVertex->get_Z(&z)))
                bSuccess = TRUE;
            pIVertex->Release();
        }
        pVerts->Release();
    }
    return bSuccess;
}

const long GF_COSMETIC = 128;

struct BezierCoeffs
{
    double t, tSquared, tCubed,
        oneMinusT, oneMinusTSquared, oneMinusTCubed;
};

double BezierEvaluate(const double v[4], const BezierCoeffs& c)
{
    double vResult = c.oneMinusTCubed * v[0] +
        3.0 * c.t * c.oneMinusTSquared * v[1] +
        3.0 * c.tSquared * c.oneMinusT * v[2] +
        c.tCubed * v[3];
    return vResult;
}

void CAutoSpline::Regen(LPDISPATCH AGraphic)
{
    IGraphic* pIGraphic = NULL;
    if (FAILED(AGraphic->QueryInterface(IID_IGraphic, (void**)&pIGraphic)))
        return;

    long lockCount = 0;
    if (SUCCEEDED(pIGraphic->RegenLock(&lockCount)))
    {
        if (lockCount == 0)
        {
            // TODO:  All the curve processing goes here
            Graphics* pGraphics = NULL;
            IGraphic* pChild = NULL;
            IVertex* pIVertex = NULL;
            if (SUCCEEDED(pIGraphic->get_Graphics(&pGraphics)))
            {
                COleVariant flags = (const long)GF_COSMETIC;
                pGraphics->Clear(&flags);

                long nSegments = 16;
                Properties* pProps = NULL;
                Property* pProp = NULL;
                COleVariant varIndex, varValue;
                if (SUCCEEDED(pIGraphic->get_Properties(&pProps)))
                {
                    varIndex = "Segments";
                    if (SUCCEEDED(pProps->get_Item(&varIndex, &pProp)))
                    {
                        if (SUCCEEDED(pProp->get_Value(0, &varValue)) &&
                            varValue.vt == VT_I4)
                        {
                            nSegments = varValue.lVal;
                            if (nSegments > 200)
                                nSegments = 200;
                            else if (nSegments < 2)
                                nSegments = 2;
                        }
                        pProp->Release();
                    }
                    pProps->Release();
                }

                double px[4] = { 0.0 };
                double py[4] = { 0.0 };
                double pz[4] = { 0.0 };
                for (int i = 0; i < 4; ++i)
                    GetVertexXYZ(pIGraphic, i, px[i], py[i], pz[i]);

                if (SUCCEEDED(pGraphics->Add(
                    &missing /*GraphicType*/,
                    &missing /*RegenMethod*/,
                    &missing /*Inherit*/,
                    &missing /*Style*/,
                    &missing /*Before*/,
                    &missing /*After*/,
                    &pChild)))
                {
                    pChild->put_Cosmetic(TRUE);

                    COleVariant x, y, z;
                    Vertices* pVerts = NULL;
                    IVertex* pIVertex = NULL;
                    if (SUCCEEDED(pChild->get_Vertices(&pVerts)))
                    {
                        BezierCoeffs c;
                        BOOL bFirst = TRUE;
                        for (long lt = 0; lt <= nSegments; ++lt)
                        {
                            c.t = (lt == nSegments) ? 1.0 : (double)lt/double(nSegments);
                            c.tSquared = c.t * c.t;
                            c.tCubed = c.tSquared * c.t;
                            c.oneMinusT = 1.0 - c.t;
                            c.oneMinusTSquared = c.oneMinusT * c.oneMinusT;
                            c.oneMinusTCubed = c.oneMinusTSquared * c.oneMinusT;

                            x = BezierEvaluate(px, c);
                            y = BezierEvaluate(py, c);
                            z = BezierEvaluate(pz, c);

                            if (SUCCEEDED(pVerts->Add(&x, &y, &z,
                                bFirst ? &f : &t /*penDown*/,
                                &f /*selectable*/,
                                &f /*snappable*/,
                                &f /*editable*/,
                                &f /*linkable*/,
                                &f /*calculated*/,
                                &missing /*before*/,
                                &missing /*after*/,
                                &pIVertex)))
                                pIVertex->Release();
                            bFirst = FALSE;
                        }
                        pVerts->Release();
                    }
                    pChild->Release();
                }
                pGraphics->Release();
            }
        }
        pIGraphic->RegenUnlock(&missing);
    }
    pIGraphic->Release();
}

BOOL CAutoSpline::Initialize(LPDISPATCH ThisRegenMethod)
{
    // TODO: Add your dispatch handler code here
    return TRUE;
}

// DUAL_SUPPORT_START

// delegate standard IDispatch methods to MFC IDispatch implementation
DELEGATE_DUAL_INTERFACE(CAutoSpline, DualSpline)

// Our method and property functions can generally just
// delegate back to the methods we generated using
// ClassWizard. However, if we set up properties to
// access variables directly, we will need to write the
//  code to get/put the value into the variable.
STDMETHODIMP CAutoSpline::XDualSpline::get_Description(BSTR FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->GetDescription();
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::get_ClassID(BSTR FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->GetClassID();
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::GetPropertyInfo(VARIANT FAR* Names, VARIANT FAR* Types, VARIANT FAR* IDs, VARIANT FAR* Defaults, long FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->GetPropertyInfo(Names, Types, IDs, Defaults);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::GetPageInfo(IDispatch * AGraphic, long FAR* StockPages, VARIANT FAR* Names, long FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->GetPageInfo(AGraphic, StockPages, Names);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::GetWizardInfo(VARIANT FAR* Names, long FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->GetWizardInfo(Names);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::GetEnumNames(long PropID, VARIANT FAR* Names, VARIANT FAR* Values, long FAR* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->GetEnumNames(PropID, Names, Values);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::PageControls(IDispatch* ThisRegenMethod, IDispatch * AGraphic, long PageNumber, VARIANT_BOOL SaveProperties, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->PageControls(ThisRegenMethod, AGraphic, PageNumber, SaveProperties);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::PageDone(IDispatch * ThisRegenMethod, VARIANT FAR* PageNumber)
{
    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        pThis->PageDone(ThisRegenMethod, PageNumber);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::PropertyPages(IDispatch* ThisRegenMethod, VARIANT FAR* PageNumber, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->PropertyPages(ThisRegenMethod, PageNumber);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::Wizard(IDispatch* ThisRegenMethod, VARIANT FAR* WizardNumber, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->Wizard(ThisRegenMethod, WizardNumber);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::OnGeometryChanged(IDispatch * AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew)
{
    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        pThis->OnGeometryChanged(AGraphic, GeomID, ParamOld, ParamNew);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::OnGeometryChanging(IDispatch * AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->OnGeometryChanging(AGraphic, GeomID, ParamOld, ParamNew);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::OnNewGraphic(IDispatch * AGraphic, VARIANT_BOOL Copy, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->OnNewGraphic(AGraphic, Copy);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::OnCopyGraphic(IDispatch* CopyGraphic, IDispatch* SourceGraphic, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->OnCopyGraphic(CopyGraphic, SourceGraphic);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::OnPropertyChanged(IDispatch * AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew)
{
    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        pThis->OnPropertyChanged(AGraphic, PropID, ValueOld, ValueNew);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::OnPropertyChanging(IDispatch * AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->OnPropertyChanging(AGraphic, PropID, ValueOld, ValueNew);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::OnPropertyGet(IDispatch * AGraphic, long PropID)
{
    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        pThis->OnPropertyGet(AGraphic, PropID);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::Draw(IDispatch * AGraphic, IDispatch * AView, VARIANT FAR* AMatrix, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->Draw(AGraphic, AView, AMatrix);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::Regen(IDispatch* AGraphic)
{
    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        pThis->Regen(AGraphic);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

STDMETHODIMP CAutoSpline::XDualSpline::Initialize(IDispatch* ThisRegenMethod, VARIANT_BOOL* retval)
{
    if (retval == NULL)
        return E_POINTER;

    METHOD_PROLOGUE(CAutoSpline, DualSpline)

    TRY_DUAL(IID_ISmartObjectServer)
    {
        *retval = pThis->Initialize(ThisRegenMethod);
        return S_OK;
    }
    CATCH_ALL_DUAL
}

// Implement ISupportErrorInfo to indicate we support the
// OLE Automation error handler.
IMPLEMENT_DUAL_ERRORINFO(CAutoSpline, IID_ISmartObjectServer)

// DUAL_SUPPORT_END


Examples - C++ Spline Regen - AutoSpl.h

AutoSpl.h

C++ Spline Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// AutoSpl.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CAutoSpline command target

class CSplinePage;  // Defined in SplPage.h.

class CAutoSpline : public CCmdTarget
{
    DECLARE_DYNCREATE(CAutoSpline)

    CAutoSpline();           // protected constructor used by dynamic creation

// Attributes
public:

// Operations
public:

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CAutoSpline)
    public:
    virtual void OnFinalRelease();
    //}}AFX_VIRTUAL

// Implementation
protected:
    virtual ~CAutoSpline();

    CSplinePage* m_pSplinePage;

    // Generated message map functions
    //{{AFX_MSG(CAutoSpline)
        // NOTE - the ClassWizard will add and remove member functions here.
    //}}AFX_MSG

    DECLARE_MESSAGE_MAP()
    DECLARE_OLECREATE(CAutoSpline)

    // Generated OLE dispatch map functions
    //{{AFX_DISPATCH(CAutoSpline)
    afx_msg BSTR GetClassID();
    afx_msg BSTR GetDescription();
    afx_msg long GetPropertyInfo(VARIANT FAR* Names, VARIANT FAR* Types, VARIANT FAR* IDs, VARIANT FAR* Defaults);
    afx_msg long GetPageInfo(LPDISPATCH AGraphic, long* StockPages, VARIANT FAR* Names);
    afx_msg long GetWizardInfo(VARIANT FAR* Names);
    afx_msg long GetEnumNames(long PropID, VARIANT FAR* Names, VARIANT FAR* Values);
    afx_msg BOOL PageControls(LPDISPATCH ThisRegenMethod, LPDISPATCH AGraphic, long PageNumber, BOOL SaveProperties);
    afx_msg void PageDone(LPDISPATCH ThisRegenMethod, VARIANT FAR* PageNumber);
    afx_msg BOOL PropertyPages(LPDISPATCH ThisRegenMethod, VARIANT FAR* PageNumber);
    afx_msg BOOL Wizard(LPDISPATCH ThisRegenMethod, VARIANT FAR* WizardNumber);
    afx_msg void OnGeometryChanged(LPDISPATCH AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew);
    afx_msg BOOL OnGeometryChanging(LPDISPATCH AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew);
    afx_msg BOOL OnNewGraphic(LPDISPATCH AGraphic, BOOL Copy);
    afx_msg BOOL OnCopyGraphic(LPDISPATCH CopyGraphic, LPDISPATCH SourceGraphic);
    afx_msg void OnPropertyChanged(LPDISPATCH AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew);
    afx_msg BOOL OnPropertyChanging(LPDISPATCH AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew);
    afx_msg void OnPropertyGet(LPDISPATCH AGraphic, long PropID);
    afx_msg BOOL Draw(LPDISPATCH AGraphic, LPDISPATCH AView, VARIANT FAR* AMatrix);
    afx_msg void Regen(LPDISPATCH AGraphic);
    afx_msg BOOL Initialize(LPDISPATCH ThisRegenMethod);
    //}}AFX_DISPATCH
    DECLARE_DISPATCH_MAP()
    DECLARE_INTERFACE_MAP()

    // DUAL_SUPPORT_START
    //    add declaration of ISmartObjectServer implementation
    //	  You need one entry here for each entry in the
    //	  interface statement of the ODL, plus the entries for a
    //	  dispatch interface. The BEGIN_DUAL_INTERFACE_PART
    //	  macro in mfcdual.h automatically generates the IDispatch
    //	  entries for you.
    //	  Each entry with the "propput" attribute needs a function
    //    named "put_<property name>". Each entry with the "propget"
    //	  attribute needs a function named "get_<property name>".
    //	  You can pull these function prototypes from the header file
    //	  generated by MKTYPLIB.
    BEGIN_DUAL_INTERFACE_PART(DualSpline, ISmartObjectServer)
        STDMETHOD(get_Description)(THIS_ BSTR FAR* retval);
        STDMETHOD(get_ClassID)(THIS_ BSTR FAR* retval);
        STDMETHOD(GetPropertyInfo)(THIS_ VARIANT FAR* Names, VARIANT FAR* Types, VARIANT FAR* IDs, VARIANT FAR* Defaults, long FAR* retval);
        STDMETHOD(GetPageInfo)(THIS_ IDispatch* AGraphic, long FAR* StockPages, VARIANT FAR* Names, long FAR* retval);
        STDMETHOD(GetWizardInfo)(THIS_ VARIANT FAR* Names, long FAR* retval);
        STDMETHOD(GetEnumNames)(THIS_ long PropID, VARIANT FAR* Names, VARIANT FAR* Values, long FAR* retval);
        STDMETHOD(PageControls)(THIS_ IDispatch* ThisRegenMethod, IDispatch* AGraphic, long PageNumber, VARIANT_BOOL SaveProperties, VARIANT_BOOL* retval);
        STDMETHOD(PageDone)(THIS_ IDispatch* ThisRegenMethod, VARIANT FAR* PageNumber);
        STDMETHOD(PropertyPages)(THIS_ IDispatch* ThisRegenMethod, VARIANT FAR* PageNumber, VARIANT_BOOL* retval);
        STDMETHOD(Wizard)(THIS_ IDispatch* ThisRegenMethod, VARIANT FAR* WizardNumber, VARIANT_BOOL* retval);
        STDMETHOD(OnGeometryChanged)(THIS_ IDispatch* AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew);
        STDMETHOD(OnGeometryChanging)(THIS_ IDispatch* AGraphic, long GeomID, VARIANT FAR* ParamOld, VARIANT FAR* ParamNew, VARIANT_BOOL* retval);
        STDMETHOD(OnNewGraphic)(THIS_ IDispatch* AGraphic, VARIANT_BOOL Copy, VARIANT_BOOL* retval);
        STDMETHOD(OnCopyGraphic)(THIS_ IDispatch* CopyGraphic, IDispatch* SourceGraphic, VARIANT_BOOL* retval);
        STDMETHOD(OnPropertyChanged)(THIS_ IDispatch* AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew);
        STDMETHOD(OnPropertyChanging)(THIS_ IDispatch* AGraphic, long PropID, VARIANT FAR* ValueOld, VARIANT FAR* ValueNew, VARIANT_BOOL* retval);
        STDMETHOD(OnPropertyGet)(THIS_ IDispatch* AGraphic, long PropID);
        STDMETHOD(Draw)(THIS_ IDispatch* AGraphic, IDispatch* AView, VARIANT FAR* AMatrix, VARIANT_BOOL* retval);
        STDMETHOD(Regen)(THIS_ IDispatch* AGraphic);
        STDMETHOD(Initialize)(THIS_ IDispatch* ThisRegenMethod, VARIANT_BOOL* retval);
    END_DUAL_INTERFACE_PART(DualSpline)

    //     add declaration of ISupportErrorInfo implementation
    //     to indicate we support the OLE Automation error object
    DECLARE_DUAL_ERRORINFO()
    // DUAL_SUPPORT_END
};

/////////////////////////////////////////////////////////////////////////////


Examples - C++ Spline Regen - Mfcdual.cpp

Mfcdual.cpp

C++ Spline Regen Example

// mfcdual.cpp: Helpful functions for adding dual interface support to
//		        MFC applications

// This is a part of the Microsoft Foundation Classes C++ library.
// Copyright (C) 1992-1996 Microsoft Corporation
// All rights reserved.
//
// This source code is only intended as a supplement to the
// Microsoft Foundation Classes Reference and related
// electronic documentation provided with the library.
// See these sources for detailed information regarding the
// Microsoft Foundation Classes product.

#include "stdafx.h"

#include <afxpriv.h>

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// DualHandleException

HRESULT DualHandleException(REFIID riidSource, const CException* pAnyException)
{
    USES_CONVERSION;

    ASSERT_VALID(pAnyException);

    TRACE0("DualHandleException called\n");

    // Set ErrInfo object so that VTLB binding container
    // applications can get rich error information.
    ICreateErrorInfo* pcerrinfo;
    HRESULT hr = CreateErrorInfo(&pcerrinfo);
    if (SUCCEEDED(hr))
    {
        TCHAR   szDescription[256];
        LPCTSTR pszDescription = szDescription;
        GUID    guid = GUID_NULL;
        DWORD   dwHelpContext = 0;
        BSTR    bstrHelpFile = NULL;
        BSTR    bstrSource = NULL;
        if (pAnyException->IsKindOf(RUNTIME_CLASS(COleDispatchException)))
        {
            // specific IDispatch style exception
            COleDispatchException* e = (COleDispatchException*)pAnyException;

            guid = riidSource;
            hr = MAKE_HRESULT(SEVERITY_ERROR, FACILITY_ITF,
                              (e->m_wCode + 0x200));

            pszDescription = e->m_strDescription;
            dwHelpContext = e->m_dwHelpContext;

            // propagate source and help file if present
            // call ::SysAllocString directly so no further exceptions are thrown
            if (!e->m_strHelpFile.IsEmpty())
                bstrHelpFile = ::SysAllocString(T2COLE(e->m_strHelpFile));
            if (!e->m_strSource.IsEmpty())
                bstrSource = ::SysAllocString(T2COLE(e->m_strSource));

        }
        else if (pAnyException->IsKindOf(RUNTIME_CLASS(CMemoryException)))
        {
            // failed memory allocation
            AfxLoadString(AFX_IDP_FAILED_MEMORY_ALLOC, szDescription);
            hr = E_OUTOFMEMORY;
        }
        else
        {
            // other unknown/uncommon error
            AfxLoadString(AFX_IDP_INTERNAL_FAILURE, szDescription);
            hr = E_UNEXPECTED;
        }

        if (bstrHelpFile == NULL && dwHelpContext != 0)
            bstrHelpFile = ::SysAllocString(T2COLE(AfxGetApp()->m_pszHelpFilePath));

        if (bstrSource == NULL)
            bstrSource = ::SysAllocString(T2COLE(AfxGetAppName()));

        // Set up ErrInfo object
        pcerrinfo->SetGUID(guid);
        pcerrinfo->SetDescription(::SysAllocString(T2COLE(pszDescription)));
        pcerrinfo->SetHelpContext(dwHelpContext);
        pcerrinfo->SetHelpFile(bstrHelpFile);
        pcerrinfo->SetSource(bstrSource);

        TRACE("\tSource = %ws\n", bstrSource);
        TRACE("\tDescription = %s\n", pszDescription);
        TRACE("\tHelpContext = %lx\n", dwHelpContext);
        TRACE("\tHelpFile = %ws\n", bstrHelpFile);

        // Set the ErrInfo object for the current thread
        IErrorInfo* perrinfo;
        if (SUCCEEDED(pcerrinfo->QueryInterface(IID_IErrorInfo, (LPVOID*)&perrinfo)))
        {
            SetErrorInfo(0, perrinfo);
            perrinfo->Release();
        }

        pcerrinfo->Release();
    }

    TRACE("DualHandleException returning HRESULT %lx\n", hr);

    return hr;
}


Examples - C++ Spline Regen - Mfcdual.h

Mfcdual.h

C++ Spline Regen Example

// mfcdual.h: Helpful macros for adding dual interface support to
//			  MFC applications

// This is a part of the Microsoft Foundation Classes C++ library.
// Copyright (C) 1992-1996 Microsoft Corporation
// All rights reserved.
//
// This source code is only intended as a supplement to the
// Microsoft Foundation Classes Reference and related
// electronic documentation provided with the library.
// See these sources for detailed information regarding the
// Microsoft Foundation Classes product.

/////////////////////////////////////////////////////////////////////
// BEGIN_DUAL_INTERFACE_PART is just like BEGIN_INTERFACE_PART,
// except that it also adds the IDispatch methods to your class
// declaration.
#define BEGIN_DUAL_INTERFACE_PART(localClass, baseClass) \
    BEGIN_INTERFACE_PART(localClass, baseClass) \
       STDMETHOD(GetTypeInfoCount)(UINT FAR* pctinfo); \
       STDMETHOD(GetTypeInfo)(UINT itinfo, LCID lcid, ITypeInfo FAR* FAR* pptinfo); \
       STDMETHOD(GetIDsOfNames)(REFIID riid, OLECHAR FAR* FAR* rgszNames, UINT cNames, LCID lcid, DISPID FAR* rgdispid); \
       STDMETHOD(Invoke)(DISPID dispidMember, REFIID riid, LCID lcid, WORD wFlags, DISPPARAMS FAR* pdispparams, VARIANT FAR* pvarResult, EXCEPINFO FAR* pexcepinfo, UINT FAR* puArgErr); \

/////////////////////////////////////////////////////////////////////
// END_DUAL_INTERFACE_PART is just like END_INTERFACE_PART. It
// is only added for symmetry...
#define END_DUAL_INTERFACE_PART(localClass) \
    END_INTERFACE_PART(localClass) \

/////////////////////////////////////////////////////////////////////
// DELEGATE_DUAL_INTERFACE expands to define the standard IDispatch
// methods for a dual interface, delegating back to the default
// MFC implementation
#define DELEGATE_DUAL_INTERFACE(objectClass, dualClass) \
    STDMETHODIMP_(ULONG) objectClass::X##dualClass::AddRef() \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        return pThis->ExternalAddRef(); \
    } \
    STDMETHODIMP_(ULONG) objectClass::X##dualClass::Release() \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        return pThis->ExternalRelease(); \
    } \
    STDMETHODIMP objectClass::X##dualClass::QueryInterface( \
        REFIID iid, LPVOID* ppvObj) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        return pThis->ExternalQueryInterface(&iid, ppvObj); \
    } \
    STDMETHODIMP objectClass::X##dualClass::GetTypeInfoCount( \
        UINT FAR* pctinfo) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->GetTypeInfoCount(pctinfo); \
    } \
    STDMETHODIMP objectClass::X##dualClass::GetTypeInfo( \
        UINT itinfo, LCID lcid, ITypeInfo FAR* FAR* pptinfo) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->GetTypeInfo(itinfo, lcid, pptinfo); \
    } \
    STDMETHODIMP objectClass::X##dualClass::GetIDsOfNames( \
        REFIID riid, OLECHAR FAR* FAR* rgszNames, UINT cNames, \
        LCID lcid, DISPID FAR* rgdispid) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->GetIDsOfNames(riid, rgszNames, cNames, \
                                         lcid, rgdispid); \
    } \
    STDMETHODIMP objectClass::X##dualClass::Invoke( \
        DISPID dispidMember, REFIID riid, LCID lcid, WORD wFlags, \
        DISPPARAMS FAR* pdispparams, VARIANT FAR* pvarResult, \
        EXCEPINFO FAR* pexcepinfo, UINT FAR* puArgErr) \
    { \
        METHOD_PROLOGUE(objectClass, dualClass) \
        LPDISPATCH lpDispatch = pThis->GetIDispatch(FALSE); \
        ASSERT(lpDispatch != NULL); \
        return lpDispatch->Invoke(dispidMember, riid, lcid, \
                                  wFlags, pdispparams, pvarResult, \
                                  pexcepinfo, puArgErr); \
    } \

/////////////////////////////////////////////////////////////////////
// TRY_DUAL and CATCH_ALL_DUAL are used to provide exception handling
// for your dual interface methods. CATCH_ALL_DUAL takes care of
// returning the appropriate error code.

#define TRY_DUAL(iidSource) \
    HRESULT _hr = S_OK; \
    REFIID  _riidSource = iidSource; \
    TRY \

#define CATCH_ALL_DUAL \
    CATCH(COleException, e) \
    { \
        _hr = e->m_sc; \
    } \
    AND_CATCH_ALL(e) \
    { \
        AFX_MANAGE_STATE(pThis->m_pModuleState); \
        _hr = DualHandleException(_riidSource, e); \
    } \
    END_CATCH_ALL \
    return _hr; \

/////////////////////////////////////////////////////////////////////
// DualHandleException is a helper function used to set the system's
// error object, so that container applications that call through
// VTBLs can retrieve rich error information
HRESULT DualHandleException(REFIID riidSource, const CException* pAnyException);

/////////////////////////////////////////////////////////////////////
// DECLARE_DUAL_ERRORINFO expands to declare the ISupportErrorInfo
// support class. It works together with DUAL_ERRORINFO_PART and
// IMPLEMENT_DUAL_ERRORINFO defined below.
#define DECLARE_DUAL_ERRORINFO() \
    BEGIN_INTERFACE_PART(SupportErrorInfo, ISupportErrorInfo) \
        STDMETHOD(InterfaceSupportsErrorInfo)(THIS_ REFIID riid); \
    END_INTERFACE_PART(SupportErrorInfo) \

/////////////////////////////////////////////////////////////////////
// DUAL_ERRORINFO_PART adds the appropriate entry to the interface map
// for ISupportErrorInfo, if you used DECLARE_DUAL_ERRORINFO.
#define DUAL_ERRORINFO_PART(objectClass) \
    INTERFACE_PART(objectClass, IID_ISupportErrorInfo, SupportErrorInfo) \

/////////////////////////////////////////////////////////////////////
// IMPLEMENT_DUAL_ERRORINFO expands to an implementation of
// ISupportErrorInfo which matches the declaration in
// DECLARE_DUAL_ERRORINFO.
#define IMPLEMENT_DUAL_ERRORINFO(objectClass, riidSource) \
    STDMETHODIMP_(ULONG) objectClass::XSupportErrorInfo::AddRef() \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return pThis->ExternalAddRef(); \
    } \
    STDMETHODIMP_(ULONG) objectClass::XSupportErrorInfo::Release() \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return pThis->ExternalRelease(); \
    } \
    STDMETHODIMP objectClass::XSupportErrorInfo::QueryInterface( \
        REFIID iid, LPVOID* ppvObj) \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return pThis->ExternalQueryInterface(&iid, ppvObj); \
    } \
    STDMETHODIMP objectClass::XSupportErrorInfo::InterfaceSupportsErrorInfo( \
        REFIID iid) \
    { \
        METHOD_PROLOGUE(objectClass, SupportErrorInfo) \
        return (iid == riidSource) ? S_OK : S_FALSE; \
    }

/////////////////////////////////////////////////////////////////////


Examples - C++ Spline Regen - MfcSplin.cpp

MfcSplin.cpp

C++ Spline Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// MfcSplin.cpp : Defines the initialization routines for the DLL.
//

#include "stdafx.h"
#include "MfcSplin.h"
#include "AutoSpl.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CMfcSplinApp

BEGIN_MESSAGE_MAP(CMfcSplinApp, CWinApp)
    //{{AFX_MSG_MAP(CMfcSplinApp)
        // NOTE - the ClassWizard will add and remove mapping macros here.
        //    DO NOT EDIT what you see in these blocks of generated code!
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CMfcSplinApp construction

// DUAL_SUPPORT_START
//    GUID for the type library (for registry functions)
static const GUID LIBID_MfcSplin =
    { 0x7724BB42L,0xB671,0x11D0,0x9B,0x3B,0x44,0x45,0x53,0x54,0x00,0x00 };
// DUAL_SUPPORT_END

CMfcSplinApp::CMfcSplinApp()
{
}

/////////////////////////////////////////////////////////////////////////////
// The one and only CMfcSplinApp object

CMfcSplinApp theApp;

/////////////////////////////////////////////////////////////////////////////
// CMfcSplinApp initialization

BOOL CMfcSplinApp::InitInstance()
{
      // Register all OLE server (factories) as running.  This enables the
    //  OLE libraries to create objects from other applications.
    COleObjectFactory::RegisterAll();

    // DUAL_SUPPORT_START
    //    make sure the type library is registerd. Otherwise dual interface won't work!
    //    note that we are embedding type library as a resource in this DLL.
    AfxOleRegisterTypeLib(AfxGetInstanceHandle(), LIBID_MfcSplin);
    // DUAL_SUPPORT_END

    return TRUE;
}

/////////////////////////////////////////////////////////////////////////////
// Special entry points required for inproc servers

STDAPI DllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID* ppv)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    return AfxDllGetClassObject(rclsid, riid, ppv);
}

STDAPI DllCanUnloadNow(void)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    return AfxDllCanUnloadNow();
}

// by exporting DllRegisterServer, you can use regsvr.exe
STDAPI DllRegisterServer(void)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    COleObjectFactory::UpdateRegistryAll();
    return S_OK;
}


Examples - C++ Spline Regen - MfcSplin.h

MfcSplin.h

C++ Spline Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// MfcSplin.h : main header file for the MFCSPLIN DLL
//

#ifndef __AFXWIN_H__
    #error include 'stdafx.h' before including this file for PCH
#endif

#include "resource.h"		// main symbols

/////////////////////////////////////////////////////////////////////////////
// CMfcSplinApp
// See MfcSplin.cpp for the implementation of this class
//

class CMfcSplinApp : public CWinApp
{
public:
    CMfcSplinApp();

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CMfcSplinApp)
    public:
    virtual BOOL InitInstance();
    //}}AFX_VIRTUAL

    //{{AFX_MSG(CMfcSplinApp)
        // NOTE - the ClassWizard will add and remove member functions here.
        //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

/////////////////////////////////////////////////////////////////////////////


Examples - C++ Spline Regen - SplPage.cpp

SplPage.cpp

C++ Spline Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// SplPage.cpp : implementation file
//

#include "stdafx.h"
#include "MfcSplin.h"
#include "SplPage.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CSplinePage dialog

CSplinePage::CSplinePage(CWnd* pParent /*=NULL*/)
    : CDialog(CSplinePage::IDD, pParent)
{
    //{{AFX_DATA_INIT(CSplinePage)
    m_nSegments = 0;
    m_bControlPoints = FALSE;
    m_bFrame = FALSE;
    m_bSmoothing = FALSE;
    //}}AFX_DATA_INIT
}

void CSplinePage::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CSplinePage)
    DDX_Text(pDX, IDC_SEGMENTS, m_nSegments);
    DDV_MinMaxUInt(pDX, m_nSegments, 1, 200);
    DDX_Check(pDX, IDC_SHOW_CONTROL_POINTS, m_bControlPoints);
    DDX_Check(pDX, IDC_SHOW_FRAME, m_bFrame);
    DDX_Check(pDX, IDC_SMOOTHING, m_bSmoothing);
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CSplinePage, CDialog)
    //{{AFX_MSG_MAP(CSplinePage)
        // NOTE: the ClassWizard will add message map macros here
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CSplinePage message handlers


Examples - C++ Spline Regen - SplPage.h

SplPage.h

C++ Spline Regen Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// SplPage.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CSplinePage dialog

class CSplinePage : public CDialog
{
// Construction
public:
    CSplinePage(CWnd* pParent = NULL);   // standard constructor

// Dialog Data
    //{{AFX_DATA(CSplinePage)
    enum { IDD = IDD_PP_SPLINE };
    UINT	m_nSegments;
    BOOL	m_bControlPoints;
    BOOL	m_bFrame;
    BOOL	m_bSmoothing;
    //}}AFX_DATA

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CSplinePage)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:

    // Generated message map functions
    //{{AFX_MSG(CSplinePage)
        // NOTE: the ClassWizard will add member functions here
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};


Examples - C++ Printing Server - PrintCAD.cpp

PrintCAD.cpp

C++ Printing Server Example

// PrintCAD.cpp : Implementation of DLL Exports.

// Note: Proxy/Stub Information
//      To build a separate proxy/stub DLL,
//      run nmake -f PrintCADps.mk in the project directory.

#include "stdafx.h"
#include "resource.h"
#include <initguid.h>
#include "PrintCAD.h"

#include "PrintCAD_i.c"
#include "PrintDr.h"

CComModule _Module;

BEGIN_OBJECT_MAP(ObjectMap)
OBJECT_ENTRY(CLSID_PrintDr, CPrintDr)
END_OBJECT_MAP()

class CPrintCADApp : public CWinApp
{
public:

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CPrintCADApp)
    public:
    virtual BOOL InitInstance();
    virtual int ExitInstance();
    //}}AFX_VIRTUAL

    //{{AFX_MSG(CPrintCADApp)
        // NOTE - the ClassWizard will add and remove member functions here.
        //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

BEGIN_MESSAGE_MAP(CPrintCADApp, CWinApp)
    //{{AFX_MSG_MAP(CPrintCADApp)
        // NOTE - the ClassWizard will add and remove mapping macros here.
        //    DO NOT EDIT what you see in these blocks of generated code!
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

CPrintCADApp theApp;

BOOL CPrintCADApp::InitInstance()
{
    _Module.Init(ObjectMap, m_hInstance, &LIBID_PRINTCADLib);
    return CWinApp::InitInstance();
}

int CPrintCADApp::ExitInstance()
{
    _Module.Term();
    return CWinApp::ExitInstance();
}

/////////////////////////////////////////////////////////////////////////////
// Used to determine whether the DLL can be unloaded by OLE

STDAPI DllCanUnloadNow(void)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    return (AfxDllCanUnloadNow()==S_OK && _Module.GetLockCount()==0) ? S_OK : S_FALSE;
}

/////////////////////////////////////////////////////////////////////////////
// Returns a class factory to create an object of the requested type

STDAPI DllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID* ppv)
{
    return _Module.GetClassObject(rclsid, riid, ppv);
}

/////////////////////////////////////////////////////////////////////////////
// DllRegisterServer - Adds entries to the system registry

STDAPI DllRegisterServer(void)
{
    // registers object, typelib and all interfaces in typelib
    return _Module.RegisterServer(TRUE);
}

/////////////////////////////////////////////////////////////////////////////
// DllUnregisterServer - Removes entries from the system registry

STDAPI DllUnregisterServer(void)
{
    return _Module.UnregisterServer(TRUE);
}


Examples - C++ Printing Server - PrintCAD.h

PrintCAD.h

C++ Printing Server Example

/* this ALWAYS GENERATED file contains the definitions for the interfaces */

/* File created by MIDL compiler version 5.01.0164 */
/* at Fri Jan 22 13:01:50 1999
 */
/* Compiler settings for D:\TCAD_CUSTOMERS\PrintServer\PrintCAD\PrintCAD.idl:
    Oicf (OptLev=i2), W1, Zp8, env=Win32, ms_ext, c_ext
    error checks: allocation ref bounds_check enum stub_data
*/
//@@MIDL_FILE_HEADING(  )

/* verify that the <rpcndr.h> version is high enough to compile this file*/
#ifndef __REQUIRED_RPCNDR_H_VERSION__
#define __REQUIRED_RPCNDR_H_VERSION__ 440
#endif

#include "rpc.h"
#include "rpcndr.h"

#ifndef __RPCNDR_H_VERSION__
#error this stub requires an updated version of <rpcndr.h>
#endif // __RPCNDR_H_VERSION__

#ifndef COM_NO_WINDOWS_H
#include "windows.h"
#include "ole2.h"
#endif /*COM_NO_WINDOWS_H*/

#ifndef __PrintCAD_h__
#define __PrintCAD_h__

#ifdef __cplusplus
extern "C"{
#endif

/* Forward Declarations */

#ifndef __IPrintDr_FWD_DEFINED__
#define __IPrintDr_FWD_DEFINED__
typedef interface IPrintDr IPrintDr;
#endif 	/* __IPrintDr_FWD_DEFINED__ */

#ifndef __PrintDr_FWD_DEFINED__
#define __PrintDr_FWD_DEFINED__

#ifdef __cplusplus
typedef class PrintDr PrintDr;
#else
typedef struct PrintDr PrintDr;
#endif /* __cplusplus */

#endif 	/* __PrintDr_FWD_DEFINED__ */

/* header files for imported files */
#include "oaidl.h"
#include "ocidl.h"

void __RPC_FAR * __RPC_USER MIDL_user_allocate(size_t);
void __RPC_USER MIDL_user_free( void __RPC_FAR * );

#ifndef __IPrintDr_INTERFACE_DEFINED__
#define __IPrintDr_INTERFACE_DEFINED__

/* interface IPrintDr */
/* [unique][helpstring][dual][uuid][object] */

EXTERN_C const IID IID_IPrintDr;

#if defined(__cplusplus) && !defined(CINTERFACE)

    MIDL_INTERFACE("7364EA8D-AEB3-11D2-8C26-00403338C504")
    IPrintDr : public IDispatch
    {
    public:
        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE PrintA(
            LPDISPATCH WhichDrawing,
            long hPrintDC) = 0;

    };

#else 	/* C style interface */

    typedef struct IPrintDrVtbl
    {
        BEGIN_INTERFACE

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *QueryInterface )(
            IPrintDr __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [iid_is][out] */ void __RPC_FAR *__RPC_FAR *ppvObject);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *AddRef )(
            IPrintDr __RPC_FAR * This);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *Release )(
            IPrintDr __RPC_FAR * This);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetTypeInfoCount )(
            IPrintDr __RPC_FAR * This,
            /* [out] */ UINT __RPC_FAR *pctinfo);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetTypeInfo )(
            IPrintDr __RPC_FAR * This,
            /* [in] */ UINT iTInfo,
            /* [in] */ LCID lcid,
            /* [out] */ ITypeInfo __RPC_FAR *__RPC_FAR *ppTInfo);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetIDsOfNames )(
            IPrintDr __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [size_is][in] */ LPOLESTR __RPC_FAR *rgszNames,
            /* [in] */ UINT cNames,
            /* [in] */ LCID lcid,
            /* [size_is][out] */ DISPID __RPC_FAR *rgDispId);

        /* [local] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Invoke )(
            IPrintDr __RPC_FAR * This,
            /* [in] */ DISPID dispIdMember,
            /* [in] */ REFIID riid,
            /* [in] */ LCID lcid,
            /* [in] */ WORD wFlags,
            /* [out][in] */ DISPPARAMS __RPC_FAR *pDispParams,
            /* [out] */ VARIANT __RPC_FAR *pVarResult,
            /* [out] */ EXCEPINFO __RPC_FAR *pExcepInfo,
            /* [out] */ UINT __RPC_FAR *puArgErr);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *PrintA )(
            IPrintDr __RPC_FAR * This,
            LPDISPATCH WhichDrawing,
            long hPrintDC);

        END_INTERFACE
    } IPrintDrVtbl;

    interface IPrintDr
    {
        CONST_VTBL struct IPrintDrVtbl __RPC_FAR *lpVtbl;
    };

#ifdef COBJMACROS

#define IPrintDr_QueryInterface(This,riid,ppvObject)	\
    (This)->lpVtbl -> QueryInterface(This,riid,ppvObject)

#define IPrintDr_AddRef(This)	\
    (This)->lpVtbl -> AddRef(This)

#define IPrintDr_Release(This)	\
    (This)->lpVtbl -> Release(This)

#define IPrintDr_GetTypeInfoCount(This,pctinfo)	\
    (This)->lpVtbl -> GetTypeInfoCount(This,pctinfo)

#define IPrintDr_GetTypeInfo(This,iTInfo,lcid,ppTInfo)	\
    (This)->lpVtbl -> GetTypeInfo(This,iTInfo,lcid,ppTInfo)

#define IPrintDr_GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)	\
    (This)->lpVtbl -> GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)

#define IPrintDr_Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)	\
    (This)->lpVtbl -> Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)

#define IPrintDr_PrintA(This,WhichDrawing,hPrintDC)	\
    (This)->lpVtbl -> PrintA(This,WhichDrawing,hPrintDC)

#endif /* COBJMACROS */

#endif 	/* C style interface */

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IPrintDr_PrintA_Proxy(
    IPrintDr __RPC_FAR * This,
    LPDISPATCH WhichDrawing,
    long hPrintDC);

void __RPC_STUB IPrintDr_PrintA_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

#endif 	/* __IPrintDr_INTERFACE_DEFINED__ */

#ifndef __PRINTCADLib_LIBRARY_DEFINED__
#define __PRINTCADLib_LIBRARY_DEFINED__

/* library PRINTCADLib */
/* [helpstring][version][uuid] */

EXTERN_C const IID LIBID_PRINTCADLib;

EXTERN_C const CLSID CLSID_PrintDr;

#ifdef __cplusplus

class DECLSPEC_UUID("7364EA8F-AEB3-11D2-8C26-00403338C504")
PrintDr;
#endif
#endif /* __PRINTCADLib_LIBRARY_DEFINED__ */

/* Additional Prototypes for ALL interfaces */

/* end of Additional Prototypes */

#ifdef __cplusplus
}
#endif

#endif


Examples - C++ Printing Server - PrintDr.cpp

PrintDr.cpp

C++ Printing Server Example

// PrintDr.cpp : Implementation of CPrintDr
#include "stdafx.h"
#include "PrintCAD.h"
#include "PrintDr.h"

/////////////////////////////////////////////////////////////////////////////
// CPrintDr

COleVariant varMissing((long)DISP_E_PARAMNOTFOUND, VT_ERROR);
COleVariant varTrue(1L);
COleVariant varFalse(0L);

#define RC_REQURE	RC_BITBLT | RC_BITMAP64 /*| RC_STRETCHBLT */

STDMETHODIMP CPrintDr::PrintA(LPDISPATCH WhichDrawing, long pHDC)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    // TODO: Add your implementation code here
    IDrawing* pIDrawing = NULL;
    pIDrawing = (IDrawing*) WhichDrawing;
    m_sDrawMode = DM_BLACK;
    m_pView = NULL;

    if (pIDrawing == NULL)
        return FALSE;

    HDC hPrintDC = (HDC) pHDC; //dlg.GetPrinterDC();
    if (hPrintDC != NULL)
    {
        int caps = ::GetDeviceCaps(hPrintDC, RASTERCAPS);

        if ((caps & (RC_REQURE)) != (RC_REQURE))
        {
            CString cstrMessage;
            cstrMessage.Format("Sorry, can't use your printer.\n \
                                Printer raster capabilities is %x", caps);
            AfxMessageBox(cstrMessage);
            return FALSE;
        }

        BOOL bMonochrom = FALSE;
        // Setup printer DC
        CDC *pPrintDC = new CDC;
        pPrintDC->Attach(hPrintDC);

        pPrintDC->m_bPrinting = TRUE;

        HDC hScreenIC = CreateIC("Display", NULL, NULL, NULL);
        int logpxScreen = ::GetDeviceCaps(hScreenIC, LOGPIXELSX);
        int logpyScreen = ::GetDeviceCaps(hScreenIC, LOGPIXELSY);
        DeleteDC(hScreenIC);

        int iOldMode = pPrintDC->SetMapMode(MM_TEXT);

        int logpxPage = pPrintDC->GetDeviceCaps(LOGPIXELSX);
        int logpyPage = pPrintDC->GetDeviceCaps(LOGPIXELSY);

        CSize cszOldPage = pPrintDC->ScaleWindowExt(logpxPage, logpxScreen,
                                                    logpyPage, logpyScreen);

        int cxPage = pPrintDC->GetDeviceCaps(HORZRES) * 0.9;
        int cyPage = pPrintDC->GetDeviceCaps(VERTRES) * 0.9;

        CRect rcPage(0, 0, cxPage, cyPage);

        CSize cszOldViewport = pPrintDC->SetViewportExt(cxPage, -cyPage);

        if (hPrintDC != NULL)
        {

            Views *pViews = NULL;
            View *pView = NULL;

            short sOldDrawMode = m_sDrawMode;

            HRESULT hRes = S_OK;

            DOCINFO docInfo;
            memset(&docInfo, 0, sizeof(DOCINFO));
            docInfo.cbSize = sizeof(DOCINFO);
            docInfo.lpszDocName = "TurboCAD drawing"; //m_strFileName;

            pPrintDC->StartDoc(&docInfo);
            pPrintDC->StartPage();
            // ABT 052097
            // According to MS( see mfc\src\viewprnt.cpp)
            // must call OnPrepareDC on newer versions of Windows because
            // StartPage now resets the device attributes.
            ASSERT_VALID(pPrintDC);
            UNUSED(pPrintDC); // unused in release builds

            try
            {
                hRes = pIDrawing->get_Views(&pViews);
                CHECK_HRESULT(hRes)

                COleVariant varHwnd(varMissing);
                COleVariant varDC((const long)hPrintDC);

                hRes = pViews->Add(&varHwnd, &varDC, &pView);
                CHECK_HRESULT(hRes)

                hRes = pView->put_Update(FALSE);
                CHECK_HRESULT(hRes)

                hRes = pView->put_CenterOnExtents(TRUE);
                CHECK_HRESULT(hRes)

                hRes = pView->put_MappingMode(MM_TEXT);
                CHECK_HRESULT(hRes)

                hRes = pView->put_Margins(FALSE);
                CHECK_HRESULT(hRes)

                hRes = pView->put_FixedAspectRatio(TRUE);
                CHECK_HRESULT(hRes)

                hRes = pView->put_ScreenLeft(0);
                CHECK_HRESULT(hRes)

                hRes = pView->put_ScreenTop(0);
                CHECK_HRESULT(hRes)

                hRes = pView->put_ScreenWidth(cxPage);
                CHECK_HRESULT(hRes)

                hRes = pView->put_ScreenHeight(cyPage);
                CHECK_HRESULT(hRes)

                SetDrawModeEx(DM_WHITE | DM_INVERT);

                hRes = pView->ZoomToExtents();
                CHECK_HRESULT(hRes)

            }
            catch (...)
            {
            }

            SetDrawModeEx(sOldDrawMode);

            if (pView != NULL)
                pView->Release();

            if (pViews != NULL)
                pViews->Release();

        }

        pPrintDC->EndPage();
        pPrintDC->SetViewportExt(cszOldViewport);
        pPrintDC->SetWindowExt(cszOldPage);
        pPrintDC->SetMapMode(iOldMode);
        int nResult = pPrintDC->EndDoc();
        ASSERT(nResult >= 0);
        pPrintDC->Detach();

        delete pPrintDC;

    }

    // TODO: Add your implementation code here

    return S_OK;
}

void CPrintDr::SetDrawModeEx(short nNewValue)
{
    m_sDrawMode = nNewValue;
    ASSERT((m_sDrawMode & DM_CHECKBITMAP) != DM_CHECKBITMAP);

    switch (m_sDrawMode)
    {
        case DM_WHITE:
            m_clrBackGround = RGB(255, 255, 255);
        break;
        case DM_INVERT | DM_WHITE:
            m_clrBackGround = RGB(0, 0, 0);
        break;
        case DM_INVERT | DM_BLACK:
            m_clrBackGround = RGB(255, 255, 255);
        break;
        case DM_BLACK:
        default:
            m_clrBackGround = RGB(0, 0, 0);
        break;
    }

}


Examples - C++ Printing Server - PrintDr.h

PrintDr.h

C++ Printing Server Example

// PrintDr.h : Declaration of the CPrintDr

#ifndef __PRINTDR_H_
#define __PRINTDR_H_

#include "resource.h"       // main symbols

/////////////////////////////////////////////////////////////////////////////
// CPrintDr
class ATL_NO_VTABLE CPrintDr :
    public CComObjectRootEx<CComSingleThreadModel>,
    public CComCoClass<CPrintDr, &CLSID_PrintDr>,
    public IDispatchImpl<IPrintDr, &IID_IPrintDr, &LIBID_PRINTCADLib>
{
public:
    CPrintDr()
    {
    }

DECLARE_REGISTRY_RESOURCEID(IDR_PRINTDR)

DECLARE_PROTECT_FINAL_CONSTRUCT()

BEGIN_COM_MAP(CPrintDr)
    COM_INTERFACE_ENTRY(IPrintDr)
    COM_INTERFACE_ENTRY(IDispatch)
END_COM_MAP()

// IPrintDr
public:
    short m_sDrawMode;
    STDMETHOD(PrintA)(LPDISPATCH WhichDrawing, long hPrintDC);
private:
    COLORREF m_clrBackGround;
    void SetDrawModeEx(short nNewValue);
protected:
    View* m_pView;
};

#endif //__PRINTDR_H_


Examples - C++ Printing Server - frmSamplePrint.frm

frmSamplePrint.frm

C++ Printing Server Example

VERSION 5.00
Begin VB.Form frmSamplePrint
   AutoRedraw      =   -1  'True
   Caption         =   "In process server "
   ClientHeight    =   6630
   ClientLeft      =   2235
   ClientTop       =   1710
   ClientWidth     =   7815
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6630
   ScaleWidth      =   7815
   Begin VB.CommandButton Command1
      Caption         =   "Refresh"
      Height          =   360
      Left            =   6255
      TabIndex        =   5
      Top             =   2535
      Width           =   1140
   End
   Begin VB.CommandButton Print1
      Caption         =   "Print"
      Enabled         =   0   'False
      Height          =   495
      Left            =   6240
      TabIndex        =   4
      Top             =   1800
      Width           =   1215
   End
   Begin VB.CommandButton Exit
      Caption         =   "Exit"
      Height          =   495
      Left            =   6240
      TabIndex        =   3
      Top             =   5520
      Width           =   1215
   End
   Begin VB.CommandButton SavetoFile
      Caption         =   "Save to File"
      Enabled         =   0   'False
      Height          =   495
      Left            =   6240
      TabIndex        =   2
      ToolTipText     =   "Save editing drawing to new File"
      Top             =   1080
      Width           =   1215
   End
   Begin VB.CommandButton OpenFile
      Caption         =   "Open File"
      Height          =   495
      Left            =   6240
      TabIndex        =   1
      ToolTipText     =   "Add existing file"
      Top             =   240
      Width           =   1215
   End
   Begin VB.PictureBox Frame1
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H80000009&
      Height          =   5745
      Left            =   360
      MousePointer    =   2  'Cross
      ScaleHeight     =   379
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   363
      TabIndex        =   0
      Top             =   255
      Width           =   5505
   End
End
Attribute VB_Name = "frmSamplePrint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Private Sub Command1_Click()
    Frame1.Refresh
    Vi.Refresh
    'Vi.ZoomToExtents
End Sub

Private Sub OpenFile_Click()
    On Error GoTo ErrorHandler
    'open cad file and create graphics object
Dim CadFile As String
    CadFile = App.Path & "\testcad.tcw"
    Set Dr = Drs.Open(CadFile)
    Set Bls = Dr.Blocks ' Blocks collection

    Set Vis = Dr.Views
    Set Vi = Vis.Add(, Frame1.hDC) '(Frame1.hWnd)
'    Set Vi = Vis.Add(Frame1.hWnd)
'    Vi.MappingMode = 1
'    Vi.FixedAspectRatio = True

     Vi.ScreenTop = Frame1.ScaleTop  '- 10
     Vi.ScreenLeft = Frame1.ScaleTop
     Vi.ScreenHeight = Frame1.ScaleHeight
     Vi.ScreenWidth = Frame1.ScaleWidth
     'Vi.ZoomToExtents
    'Frame1.Refresh

    Vi.ZoomToExtents
    Frame1.Refresh
    Vi.Refresh

    SaveToFile.Enabled = True
    Print1.Enabled = True

    Exit Sub
ErrorHandler:
    MsgBox Err.Description
End Sub

Private Sub Exit_Click()
    On Error GoTo ErrorHandler
    Call Finish
  '    Unload Form2
      Unload Me
    Exit Sub
ErrorHandler:
    MsgBox ("Form_Exit " & Err.Description)

End Sub

Private Sub Form_Load()
    On Error GoTo ErrorHandler
    Set objApp = CreateObject("IMSIGX.Application")
    If objApp Is Nothing Then
        MsgBox "Could not start server.  " & Err.Description & "  Quitting."
        Exit Sub
    End If
    Set Drs = objApp.Drawings
    If Drs Is Nothing Then
        MsgBox "Bad server.  " & Err.Description & "  Quitting"
        Exit Sub
    End If
    Exit Sub
ErrorHandler:
    MsgBox ("Form_Load " & Err.Description)
End Sub

Private Sub Form_Paint()
    On Error GoTo ErrorHandler
    If Vi Is Nothing Then
        Exit Sub
    Else
        Vi.ZoomToExtents
    End If
    Exit Sub
ErrorHandler:
    MsgBox ("Form_Paint " & Err.Description)

End Sub

Private Sub Form_Unload(Cancel As Integer)
    On Error GoTo ErrorHandler
    Call Finish
    Exit Sub
ErrorHandler:
    MsgBox ("Form_Unload " & Err.Description)
End Sub

Private Sub Frame1_Paint()
    If Vi Is Nothing Then
        Exit Sub
    Else
        Vi.ZoomToExtents
    End If

End Sub

Private Sub Print1_Click()
    Dim PrintServer As Object
    Dim objDr As Object
    Set PrintServer = New PrintDr
   If (Printers.Count = 0) Then
    MsgBox "There is not printer(s) defined"
    Exit Sub
   End If
   Set objDr = Dr
   Set Printer = Printers(1) ' choose a default printer

   PrintServer.PrintA Dr, Printer.hDC
'   PrintServer .PrintA Dr, Printer.hDC

End Sub

Private Sub SavetoFile_Click()
    On Error GoTo ErrorHandler
Dim CadFileSave As String
    CadFileSave = App.Path & "\testcadsave.tcw"
    Dr.SaveAs (CadFileSave)
    MsgBox ("The current drawing is saved to " & App.Path & "\testcadsave.tcw" & " file.")
    Exit Sub
ErrorHandler:
    MsgBox ("FileSave" & Err.Description)

End Sub

Private Sub Finish()

    Set Vi = Nothing
    Set Vis = Nothing
    Set Dr = Nothing
    Set Drs = Nothing
    Set objApp = Nothing

End Sub


Examples - C++ Printing Server - modSamplePrint.bas

modSamplePrint.bas

C++ Printing Server Example

Attribute VB_Name = "modSamplePrint"
Option Explicit

Global objApp As Application
Global Drs As Drawings
Global Dr As Drawing
Global Vis As Views
Global Vi As View
Global Bls As Blocks
Global Bl As Block

Sub Main()
    frmSamplePrint.Show 1
End Sub


Examples - C++ Server - dlldatax.h

dlldatax.h

C++ Server Example

#if !defined(AFX_DLLDATAX_H__AA0307D0_F7D5_11D2_8C80_00403338C504__INCLUDED_)
#define AFX_DLLDATAX_H__AA0307D0_F7D5_11D2_8C80_00403338C504__INCLUDED_

#if _MSC_VER > 1000
#pragma once
#endif // _MSC_VER > 1000

#ifdef _MERGE_PROXYSTUB

extern "C"
{
BOOL WINAPI PrxDllMain(HINSTANCE hInstance, DWORD dwReason,
    LPVOID lpReserved);
STDAPI PrxDllCanUnloadNow(void);
STDAPI PrxDllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID* ppv);
STDAPI PrxDllRegisterServer(void);
STDAPI PrxDllUnregisterServer(void);
}

#endif

//{{AFX_INSERT_LOCATION}}
// Microsoft Visual C++ will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_DLLDATAX_H__AA0307D0_F7D5_11D2_8C80_00403338C504__INCLUDED_)


Examples - C++ Server - TBool.cpp

TBool.cpp

C++ Server Example

// TBool.cpp : Implementation of CTBool
#include "stdafx.h"
#include "TCADEX.h"
#include "TBool.h"

//#include <float.h>

/////////////////////////////////////////////////////////////////////////////
// CTBool

BOOL	CTBool::Init()
{
    if (!m_bInit)
    {
        m_hDBAPI = GetModuleHandle(DBAPI);
        if (m_hDBAPI != NULL)
        {

            m_pfDrawingGetActiveViewport = (DRAWINGGETACTIVEVIEWPORT)GetProcAddress(m_hDBAPI, "DrawingGetActiveViewport");
            m_pfViewportGetDispatch = (VIEWPORTGETDISPATCH)GetProcAddress(m_hDBAPI, "ViewportGetDispatch");
            m_pfnGrGetDispatch = (GRAPHICGETDISPATCH)GetProcAddress(m_hDBAPI, "GraphicGetDispatch");
            if (m_pfDrawingGetActiveViewport != NULL
                && m_pfViewportGetDispatch != NULL && m_pfnGrGetDispatch != NULL)
                m_bInit = TRUE;
        }
    }
    return m_bInit;
}

View*	CTBool::GetActiveView(IDrawing *pIDwg)
{
    View *pView = NULL;

    if (Init())
    {
        HRESULT hRes = E_FAIL;

        long lDwg = 0;
        long lVp = 0;

        try
        {
            hRes = pIDwg->get__Handle(&lDwg);
            CHECK_HRESULT(hRes)

            lVp = (*m_pfDrawingGetActiveViewport)(lDwg);
            if (lVp == 0)
                throw hRes = E_FAIL;

            pView = (View*)(*m_pfViewportGetDispatch)(lVp, NULL);
            if (pView == NULL)
                throw hRes = E_FAIL;
        }
        catch (...)
        {
            _clearfp();
        }
    }

    return pView;
}

const IID IID_ITcApp =  {0x6A481200,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_IGraphic = {0x6A481109,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

HRESULT GetNode(/*IGraphic *pIGr*/Vertices *pVrts, IVertex** ppIVrt)
{
    HRESULT hRes = E_FAIL;

//	Vertices *pVrts = NULL;
    IEnumVARIANT *pEnumVrts = NULL;

    ULONG celt = 1;
    ULONG fetched = 0;

    VARIANT varVrt;
    ::VariantInit(&varVrt);

    IMSI_BOOL	bEditable = FALSE;
    IMSI_BOOL	bLinkable = FALSE;
    IMSI_BOOL	bSnapable = FALSE;

    IVertex *pIVrt = NULL;
    try
    {
//		hRes = pIGr->get_Vertices(&pVrts);
//		CHECK_HRESULT(hRes)

        hRes = pVrts->get__NewEnum((IUnknown**)&pEnumVrts);
        CHECK_HRESULT(hRes)

        hRes = pEnumVrts->Reset();
        CHECK_HRESULT(hRes)

        while (TRUE)
        {
            hRes = pEnumVrts->Next(celt, &varVrt, &fetched);
            CHECK_HRESULT(hRes)

            if (fetched == 0)
                break;

            pIVrt = (IVertex*)varVrt.pdispVal;

            hRes = pIVrt->get_Editable(&bEditable);
            CHECK_HRESULT(hRes)

            if (!bEditable)
            {
                hRes = pIVrt->get_Linkable(&bLinkable);
                CHECK_HRESULT(hRes)

                if (!bLinkable)
                {
                    hRes = pIVrt->get_Linkable(&bSnapable);
                    CHECK_HRESULT(hRes)
                }
            }

            if (bEditable
                || bLinkable
                || bSnapable)
            {
                *ppIVrt = pIVrt;
                pIVrt->AddRef();
                break;
            }
            else
            {
                hRes = S_FALSE;
            }

            varVrt.pdispVal->Release();
            varVrt.pdispVal = NULL;
            varVrt.vt = VT_EMPTY;

            if (S_OK == hRes)
                break;
        }
    }
    catch (...)
    {
    }

    ::VariantClear(&varVrt);
//	RELEASE(pVrts)
    RELEASE(pEnumVrts)

    return hRes;
}

HRESULT GetPickPoint(IGraphic *pIGr, double* px, double* py, double* pz)
{
    HRESULT hRes = E_FAIL;

    Graphics *pGrs = NULL;

    IEnumVARIANT *pEnumGrs = NULL;

    ULONG celt = 1;
    ULONG fetched = 0;

    VARIANT varGr;
    ::VariantInit(&varGr);

    Vertices *pVrts = NULL;
    IVertex *pIVrt = NULL;
    COleVariant varItem(0L);

    long lCount = 0;

    try
    {
        hRes = pIGr->get_Vertices(&pVrts);
        CHECK_HRESULT(hRes)

        hRes = GetNode(/*pIGr*/pVrts, &pIVrt);
        CHECK_HRESULT(hRes)

        if (pIVrt == NULL)
        {
            hRes = pIGr->get_Graphics(&pGrs);
            CHECK_HRESULT(hRes)

            hRes = pGrs->get__NewEnum((IUnknown**)&pEnumGrs);
            CHECK_HRESULT(hRes)

            pEnumGrs->Reset();

            while (TRUE)
            {
                hRes = pEnumGrs->Next(celt, &varGr, &fetched);
                CHECK_HRESULT(hRes)

                if (fetched == 0)
                    break;

                hRes = GetPickPoint((IGraphic*)varGr.pdispVal, px, py, pz);

                varGr.pdispVal->Release();
                varGr.pdispVal = NULL;
                varGr.vt = VT_EMPTY;

                if (S_OK == hRes)
                    break;
            }

        }
        else
        {
            hRes = pVrts->put_UseWorldCS(TRUE);
            CHECK_HRESULT(hRes)

            hRes = pIVrt->get_X(px);
            CHECK_HRESULT(hRes)

            hRes = pIVrt->get_Y(py);
            CHECK_HRESULT(hRes)

            hRes = pIVrt->get_Z(pz);
            CHECK_HRESULT(hRes)
        }
    }
    catch (...)
    {
    }

    ::VariantClear(&varGr);

    RELEASE(pEnumGrs)

    RELEASE(pIVrt)
    RELEASE(pVrts)

    return hRes;
}

STDMETHODIMP CTBool::Add(IDispatch *FirstGraphic, LPDISPATCH SecondGraphic, LPDISPATCH *ResultGraphic)
{
    HRESULT hRes = E_FAIL;
    CString cstrToolname = "Modify\nBoolean\nBooleanOperationAdd";
    UINT pToolID = 0;
    *ResultGraphic = NULL;

    double x = 0, y = 0, z = 0, x1 = 0, y1 = 0, z1 = 0;
    short retVal = 0;

    long hwndView = NULL;
    WPARAM wParam = MK_LBUTTON;
    LPARAM lParam = 0;

    IApplication *pApp = NULL;
    ITcApp *pITcApp = NULL;

    IDrawing *pIDwg = NULL;
    View *pView = NULL;

    IGraphic* pIGr1 = NULL;
    IGraphic *pIGr2 = NULL;

    try
    {

        hRes = FirstGraphic->QueryInterface(IID_IGraphic, (void**)&pIGr1);
        CHECK_HRESULT(hRes)

        hRes = SecondGraphic->QueryInterface(IID_IGraphic, (void**)&pIGr2);
        CHECK_HRESULT(hRes)

        hRes = pIGr1->get_Application(&pApp);
        CHECK_HRESULT(hRes)

        hRes = pApp->QueryInterface(IID_ITcApp, (void**)&pITcApp);
        CHECK_HRESULT(hRes)

        hRes = pITcApp->GetToolID(cstrToolname, &pToolID);
        CHECK_HRESULT(hRes)

        hRes = pITcApp->RunTool(pToolID);
        CHECK_HRESULT(hRes)

        hRes = pIGr1->get_Drawing(&pIDwg);
        CHECK_HRESULT(hRes)

        pView = GetActiveView(pIDwg);
        if (pView == NULL)
            throw hRes;

        hRes = pView->get_HWND(&hwndView);
        CHECK_HRESULT(hRes)

        hRes = GetPickPoint(pIGr1, &x, &y, &z);
        if (S_OK != hRes)
            throw hRes;

        hRes = pView->WorldToView(x, y, z, &x1, &y1, &z1);
        CHECK_HRESULT(hRes)

        hRes = pView->ViewToScreen(x1, y1, &x, &y, &retVal);
        CHECK_HRESULT(hRes)

        lParam = MAKELPARAM(x, y);
        ::SendMessage((HWND)hwndView, WM_LBUTTONDOWN, wParam, lParam);

        hRes = GetPickPoint(pIGr2, &x, &y, &z);
        if (S_OK != hRes)
            throw hRes;

        hRes = pView->WorldToView(x, y, z, &x1, &y1, &z1);
        CHECK_HRESULT(hRes)

        hRes = pView->ViewToScreen(x1, y1, &x, &y, &retVal);
        CHECK_HRESULT(hRes)

        lParam = MAKELPARAM(x, y);
        ::SendMessage((HWND)hwndView, WM_LBUTTONDOWN, wParam, lParam);

        hGraphic hGr = 0;
        hRes = pITcApp->DragGetAddedGraphic(&hGr);
        CHECK_HRESULT(hRes)

        IDispatch *pRes = NULL;
        pRes = (IDispatch*)(*m_pfnGrGetDispatch)((long)hGr, NULL);
        if (pRes == NULL)
                throw hRes = E_FAIL;

        hRes = pRes->QueryInterface(IID_IGraphic, (void**)ResultGraphic);
        CHECK_HRESULT(hRes)

        if (*ResultGraphic == NULL)
                throw hRes = E_FAIL;

    }

    catch (...)
    {
        TRACE_EXCEPTION("CTBool::Add")
        _clearfp();
    }

    RELEASE(pIGr1)
    RELEASE(pIGr2)

    RELEASE(pView)
    RELEASE(pIDwg)

    RELEASE(pITcApp)
    RELEASE(pApp)

    return hRes;

}

STDMETHODIMP CTBool::Subtract(IDispatch *FirstGraphic, LPDISPATCH SecondGraphic, LPDISPATCH *ResultGraphic)
{
    HRESULT hRes = E_FAIL;
    *ResultGraphic = NULL;

    CString cstrToolname = "Modify\nBoolean\nBooleanOperationSubtract";
    UINT pToolID = 0;

    double x = 0, y = 0, z = 0, x1 = 0, y1 = 0, z1 = 0;
    short retVal = 0;

    long hwndView = NULL;
    WPARAM wParam = MK_LBUTTON;
    LPARAM lParam = 0;

    IApplication *pApp = NULL;
    ITcApp *pITcApp = NULL;

    IDrawing *pIDwg = NULL;
    View *pView = NULL;

    IGraphic* pIGr1 = NULL;
    IGraphic *pIGr2 = NULL;

    try
    {

        hRes = FirstGraphic->QueryInterface(IID_IGraphic, (void**)&pIGr1);
        CHECK_HRESULT(hRes)

        hRes = SecondGraphic->QueryInterface(IID_IGraphic, (void**)&pIGr2);
        CHECK_HRESULT(hRes)

        hRes = pIGr1->get_Application(&pApp);
        CHECK_HRESULT(hRes)

        hRes = pApp->QueryInterface(IID_ITcApp, (void**)&pITcApp);
        CHECK_HRESULT(hRes)

        hRes = pITcApp->GetToolID(cstrToolname, &pToolID);
        CHECK_HRESULT(hRes)

        hRes = pITcApp->RunTool(pToolID);
        CHECK_HRESULT(hRes)

        hRes = pIGr1->get_Drawing(&pIDwg);
        CHECK_HRESULT(hRes)

        pView = GetActiveView(pIDwg);
        if (pView == NULL)
            throw hRes;

        hRes = pView->get_HWND(&hwndView);
        CHECK_HRESULT(hRes)

        hRes = GetPickPoint(pIGr1, &x, &y, &z);
        if (S_OK != hRes)
            throw hRes;

        hRes = pView->WorldToView(x, y, z, &x1, &y1, &z1);
        CHECK_HRESULT(hRes)

        hRes = pView->ViewToScreen(x1, y1, &x, &y, &retVal);
        CHECK_HRESULT(hRes)

        lParam = MAKELPARAM(x, y);
        ::SendMessage((HWND)hwndView, WM_LBUTTONDOWN, wParam, lParam);

        hRes = GetPickPoint(pIGr2, &x, &y, &z);
        if (S_OK != hRes)
            throw hRes;

        hRes = pView->WorldToView(x, y, z, &x1, &y1, &z1);
        CHECK_HRESULT(hRes)

        hRes = pView->ViewToScreen(x1, y1, &x, &y, &retVal);
        CHECK_HRESULT(hRes)

        lParam = MAKELPARAM(x, y);
        ::SendMessage((HWND)hwndView, WM_LBUTTONDOWN, wParam, lParam);

        hGraphic hGr = 0;
        hRes = pITcApp->DragGetAddedGraphic(&hGr);
        CHECK_HRESULT(hRes)

        IDispatch *pRes = NULL;
        pRes = (IDispatch*)(*m_pfnGrGetDispatch)((long)hGr, NULL);
        if (pRes == NULL)
                throw hRes = E_FAIL;

        hRes = pRes->QueryInterface(IID_IGraphic, (void**)ResultGraphic);
        CHECK_HRESULT(hRes)

        if (*ResultGraphic == NULL)
                throw hRes = E_FAIL;

    }

    catch (...)
    {
        TRACE_EXCEPTION("CTBool::Subtract")
        _clearfp();
    }

    RELEASE(pIGr1)
    RELEASE(pIGr2)

    RELEASE(pView)
    RELEASE(pIDwg)

    RELEASE(pITcApp)
    RELEASE(pApp)

    return hRes;
}

STDMETHODIMP CTBool::Intersection(IDispatch *FirstGraphic, LPDISPATCH SecondGraphic, LPDISPATCH *ResultGraphic)
{
    HRESULT hRes = E_FAIL;

    CString cstrToolname = "Modify\nBoolean\nBooleanOperationIntersect";
    UINT pToolID = 0;
    *ResultGraphic = NULL;

    double x = 0, y = 0, z = 0, x1 = 0, y1 = 0, z1 = 0;
    short retVal = 0;

    long hwndView = NULL;
    WPARAM wParam = MK_LBUTTON;
    LPARAM lParam = 0;

    IApplication *pApp = NULL;
    ITcApp *pITcApp = NULL;

    IDrawing *pIDwg = NULL;
    View *pView = NULL;

    IGraphic* pIGr1 = NULL;
    IGraphic *pIGr2 = NULL;

    try
    {

        hRes = FirstGraphic->QueryInterface(IID_IGraphic, (void**)&pIGr1);
        CHECK_HRESULT(hRes)

        hRes = SecondGraphic->QueryInterface(IID_IGraphic, (void**)&pIGr2);
        CHECK_HRESULT(hRes)

        hRes = pIGr1->get_Application(&pApp);
        CHECK_HRESULT(hRes)

        hRes = pApp->QueryInterface(IID_ITcApp, (void**)&pITcApp);
        CHECK_HRESULT(hRes)

        hRes = pITcApp->GetToolID(cstrToolname, &pToolID);
        CHECK_HRESULT(hRes)

        hRes = pITcApp->RunTool(pToolID);
        CHECK_HRESULT(hRes)

        hRes = pIGr1->get_Drawing(&pIDwg);
        CHECK_HRESULT(hRes)

        pView = GetActiveView(pIDwg);
        if (pView == NULL)
            throw hRes;

        hRes = pView->get_HWND(&hwndView);
        CHECK_HRESULT(hRes)

        hRes = GetPickPoint(pIGr1, &x, &y, &z);
        if (S_OK != hRes)
            throw hRes;

        hRes = pView->WorldToView(x, y, z, &x1, &y1, &z1);
        CHECK_HRESULT(hRes)

        hRes = pView->ViewToScreen(x1, y1, &x, &y, &retVal);
        CHECK_HRESULT(hRes)

        lParam = MAKELPARAM(x, y);
        ::SendMessage((HWND)hwndView, WM_LBUTTONDOWN, wParam, lParam);

        hRes = GetPickPoint(pIGr2, &x, &y, &z);
        if (S_OK != hRes)
            throw hRes;

        hRes = pView->WorldToView(x, y, z, &x1, &y1, &z1);
        CHECK_HRESULT(hRes)

        hRes = pView->ViewToScreen(x1, y1, &x, &y, &retVal);
        CHECK_HRESULT(hRes)

        lParam = MAKELPARAM(x, y);
        ::SendMessage((HWND)hwndView, WM_LBUTTONDOWN, wParam, lParam);

        hGraphic hGr = 0;
        hRes = pITcApp->DragGetAddedGraphic(&hGr);
        CHECK_HRESULT(hRes)

        IDispatch *pRes = NULL;
        pRes = (IDispatch*)(*m_pfnGrGetDispatch)((long)hGr, NULL);
        if (pRes == NULL)
                throw hRes = E_FAIL;

        hRes = pRes->QueryInterface(IID_IGraphic, (void**)ResultGraphic);
        CHECK_HRESULT(hRes)

        if (*ResultGraphic == NULL)
                throw hRes = E_FAIL;
    }

    catch (...)
    {
        TRACE_EXCEPTION("CTBool::Intersection")
        _clearfp();
    }

    RELEASE(pIGr1)
    RELEASE(pIGr2)

    RELEASE(pView)
    RELEASE(pIDwg)

    RELEASE(pITcApp)
    RELEASE(pApp)

    return hRes;

    // TODO: Add your implementation code here

}
/*
STDMETHODIMP CTBool::DoRender(IDispatch *Graphic)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;
///	return hRes;
    IDrawing *pIDwg = NULL;
    View *pView = NULL;

    IGraphic* pIGr1 = NULL;

    long hwndView = NULL;
    long hwndDrawing = NULL;
    long lDwg = 0;
    long lView = 0;

    m_hDBAPI = GetModuleHandle(DBAPI);

    RENDERGETDEFAULTRENDER pfRenderGetDefaultRender = 0;
    pfRenderGetDefaultRender = (RENDERGETDEFAULTRENDER)GetProcAddress(m_hDBAPI, "RenderGetDefaultRender");

    RENDERSCENENEW pfRenderSceneNew = 0;
    pfRenderSceneNew = (RENDERSCENENEW)GetProcAddress(m_hDBAPI, "RenderSceneNew");

    RENDERSCENEBEGINRENDER pfRenderSceneBeginRender = 0;
    pfRenderSceneBeginRender = (RENDERSCENEBEGINRENDER)	GetProcAddress(m_hDBAPI, "RenderSceneBeginRender");

    RENDERCOUNTRENDERS	pfRenderCountRenders = 0;
    pfRenderCountRenders = (RENDERCOUNTRENDERS)	GetProcAddress(m_hDBAPI, "RenderCountRenders");

    RENDERSCENEDORENDER	pfRenderSceneDoRender= 0;
    pfRenderSceneDoRender = (RENDERSCENEDORENDER) GetProcAddress(m_hDBAPI, "RenderSceneDoRender");

    try
    {

        hRes = Graphic->QueryInterface(IID_IGraphic, (void**)&pIGr1);
        CHECK_HRESULT(hRes)

        hRes = pIGr1->get_Drawing(&pIDwg);
        CHECK_HRESULT(hRes)

//		pView = GetActiveView(pIDwg);
//		if (pView == NULL)
//			throw hRes;

        long lVp = 0;

        hRes = pIDwg->get__Handle(&lDwg);
        CHECK_HRESULT(hRes)

        lVp = (*m_pfDrawingGetActiveViewport)(lDwg);
//		if (lVp == 0)
//				throw hRes = E_FAIL;

//		int renderCount = (int) (*pfRenderCountRenders)();
//		renderCount = 0;
        int renderId = (int)(*pfRenderGetDefaultRender)();
        int flag = 0;
        int sceneId = (int)(*pfRenderSceneNew)(lVp, lDwg, renderId, flag, NULL);

        long res = 0;

        res = (long)(*pfRenderSceneBeginRender)(sceneId);

        long res1 = 0;

        res1 = (long) (*pfRenderSceneDoRender)(sceneId, lVp, NULL, NULL);

//		renderCount = (int) (*pfRenderCountRenders)();

    }

    catch (...)
    {
        TRACE_EXCEPTION("CTBool::DoRender")
        _clearfp();
    }

    // TODO: Add your implementation code here

    return S_OK;
}
*/


Examples - C++ Server - TBool.h

TBool.h

C++ Server Example

// TBool.h : Declaration of the CTBool

#ifndef __TBOOL_H_
#define __TBOOL_H_

#include "resource.h"       // main symbols

/////////////////////////////////////////////////////////////////////////////
// CTBool
class ATL_NO_VTABLE CTBool :
    public CComObjectRootEx<CComSingleThreadModel>,
    public CComCoClass<CTBool, &CLSID_TBool>,
    public IDispatchImpl<ITBool, &IID_ITBool, &LIBID_TCADEXLib>
{
    HINSTANCE	m_hDBAPI;
    BOOL		m_bInit;

    VIEWPORTGETDISPATCH			m_pfViewportGetDispatch;
    DRAWINGGETACTIVEVIEWPORT	m_pfDrawingGetActiveViewport;
    GRAPHICGETDISPATCH			m_pfnGrGetDispatch;
    BOOL	Init();
    View*	GetActiveView(IDrawing *pIDwg);

public:
    CTBool()
    {
        m_hDBAPI = NULL;
        m_bInit = NULL;

        m_pfViewportGetDispatch = NULL;
        m_pfDrawingGetActiveViewport = NULL;
        m_pfnGrGetDispatch = NULL;
    }

DECLARE_REGISTRY_RESOURCEID(IDR_TBOOL)

DECLARE_PROTECT_FINAL_CONSTRUCT()

BEGIN_COM_MAP(CTBool)
    COM_INTERFACE_ENTRY(ITBool)
    COM_INTERFACE_ENTRY(IDispatch)
END_COM_MAP()

// ITBool
public:
//	STDMETHOD(DoRender)(/*[in]*/ IDispatch *Graphic);
    STDMETHOD(Intersection)(/*[in]*/ IDispatch *FirstGraphic, /*[in]*/ LPDISPATCH SecondGraphic, /*[out, retval]*/ LPDISPATCH *ResultGraphic);
    STDMETHOD(Subtract)(/*[in]*/ IDispatch *FirstGraphic, /*[in]*/ LPDISPATCH SecondGraphic, /*[out, retval]*/ LPDISPATCH *ResultGraphic);
    STDMETHOD(Add)(/*[in]*/ IDispatch *FirstGraphic, /*[in]*/ LPDISPATCH SecondGraphic, /*[out, retval]*/ LPDISPATCH *ResultGraphic);
};

#endif //__TBOOL_H_


Examples - C++ Server - TCADEX.cpp

TCADEX.cpp

C++ Server Example

// TCADEX.cpp : Implementation of DLL Exports.

// Note: Proxy/Stub Information
//      To merge the proxy/stub code into the object DLL, add the file
//      dlldatax.c to the project.  Make sure precompiled headers
//      are turned off for this file, and add _MERGE_PROXYSTUB to the
//      defines for the project.
//
//      If you are not running WinNT4.0 or Win95 with DCOM, then you
//      need to remove the following define from dlldatax.c
//      #define _WIN32_WINNT 0x0400
//
//      Further, if you are running MIDL without /Oicf switch, you also
//      need to remove the following define from dlldatax.c.
//      #define USE_STUBLESS_PROXY
//
//      Modify the custom build rule for TCADEX.idl by adding the following
//      files to the Outputs.
//          TCADEX_p.c
//          dlldata.c
//      To build a separate proxy/stub DLL,
//      run nmake -f TCADEXps.mk in the project directory.

#include "stdafx.h"
#include "resource.h"
#include <initguid.h>
#include "TCADEX.h"
#include "dlldatax.h"

#include "TCADEX_i.c"
#include "TBool.h"
#include "TRender.h"

#ifdef _MERGE_PROXYSTUB
extern "C" HINSTANCE hProxyDll;
#endif

CComModule _Module;

BEGIN_OBJECT_MAP(ObjectMap)
OBJECT_ENTRY(CLSID_TBool, CTBool)
OBJECT_ENTRY(CLSID_TRender, CTRender)
END_OBJECT_MAP()

class CTCADEXApp : public CWinApp
{
public:

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CTCADEXApp)
    public:
    virtual BOOL InitInstance();
    virtual int ExitInstance();
    //}}AFX_VIRTUAL

    //{{AFX_MSG(CTCADEXApp)
        // NOTE - the ClassWizard will add and remove member functions here.
        //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

BEGIN_MESSAGE_MAP(CTCADEXApp, CWinApp)
    //{{AFX_MSG_MAP(CTCADEXApp)
        // NOTE - the ClassWizard will add and remove mapping macros here.
        //    DO NOT EDIT what you see in these blocks of generated code!
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

CTCADEXApp theApp;

BOOL CTCADEXApp::InitInstance()
{
#ifdef _MERGE_PROXYSTUB
    hProxyDll = m_hInstance;
#endif
    _Module.Init(ObjectMap, m_hInstance, &LIBID_TCADEXLib);
    return CWinApp::InitInstance();
}

int CTCADEXApp::ExitInstance()
{
    _Module.Term();
    return CWinApp::ExitInstance();
}

/////////////////////////////////////////////////////////////////////////////
// Used to determine whether the DLL can be unloaded by OLE

STDAPI DllCanUnloadNow(void)
{
#ifdef _MERGE_PROXYSTUB
    if (PrxDllCanUnloadNow() != S_OK)
        return S_FALSE;
#endif
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    return (AfxDllCanUnloadNow()==S_OK && _Module.GetLockCount()==0) ? S_OK : S_FALSE;
}

/////////////////////////////////////////////////////////////////////////////
// Returns a class factory to create an object of the requested type

STDAPI DllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID* ppv)
{
#ifdef _MERGE_PROXYSTUB
    if (PrxDllGetClassObject(rclsid, riid, ppv) == S_OK)
        return S_OK;
#endif
    return _Module.GetClassObject(rclsid, riid, ppv);
}

/////////////////////////////////////////////////////////////////////////////
// DllRegisterServer - Adds entries to the system registry

STDAPI DllRegisterServer(void)
{
#ifdef _MERGE_PROXYSTUB
    HRESULT hRes = PrxDllRegisterServer();
    if (FAILED(hRes))
        return hRes;
#endif
    // registers object, typelib and all interfaces in typelib
    return _Module.RegisterServer(TRUE);
}

/////////////////////////////////////////////////////////////////////////////
// DllUnregisterServer - Removes entries from the system registry

STDAPI DllUnregisterServer(void)
{
#ifdef _MERGE_PROXYSTUB
    PrxDllUnregisterServer();
#endif
    return _Module.UnregisterServer(TRUE);
}


Examples - C++ Server - TCADEX.h

TCADEX.h

C++ Server Example

/* this ALWAYS GENERATED file contains the definitions for the interfaces */

/* File created by MIDL compiler version 5.01.0164 */
/* at Thu May 13 11:47:19 1999
 */
/* Compiler settings for F:\Sdk8\new2\TCADEX\TCADEX.idl:
    Oicf (OptLev=i2), W1, Zp8, env=Win32, ms_ext, c_ext
    error checks: allocation ref bounds_check enum stub_data
*/
//@@MIDL_FILE_HEADING(  )

/* verify that the <rpcndr.h> version is high enough to compile this file*/
#ifndef __REQUIRED_RPCNDR_H_VERSION__
#define __REQUIRED_RPCNDR_H_VERSION__ 440
#endif

#include "rpc.h"
#include "rpcndr.h"

#ifndef __RPCNDR_H_VERSION__
#error this stub requires an updated version of <rpcndr.h>
#endif // __RPCNDR_H_VERSION__

#ifndef COM_NO_WINDOWS_H
#include "windows.h"
#include "ole2.h"
#endif /*COM_NO_WINDOWS_H*/

#ifndef __TCADEX_h__
#define __TCADEX_h__

#ifdef __cplusplus
extern "C"{
#endif

/* Forward Declarations */

#ifndef __ITBool_FWD_DEFINED__
#define __ITBool_FWD_DEFINED__
typedef interface ITBool ITBool;
#endif 	/* __ITBool_FWD_DEFINED__ */

#ifndef __ITRender_FWD_DEFINED__
#define __ITRender_FWD_DEFINED__
typedef interface ITRender ITRender;
#endif 	/* __ITRender_FWD_DEFINED__ */

#ifndef __TBool_FWD_DEFINED__
#define __TBool_FWD_DEFINED__

#ifdef __cplusplus
typedef class TBool TBool;
#else
typedef struct TBool TBool;
#endif /* __cplusplus */

#endif 	/* __TBool_FWD_DEFINED__ */

#ifndef __TRender_FWD_DEFINED__
#define __TRender_FWD_DEFINED__

#ifdef __cplusplus
typedef class TRender TRender;
#else
typedef struct TRender TRender;
#endif /* __cplusplus */

#endif 	/* __TRender_FWD_DEFINED__ */

/* header files for imported files */
#include "oaidl.h"
#include "ocidl.h"

void __RPC_FAR * __RPC_USER MIDL_user_allocate(size_t);
void __RPC_USER MIDL_user_free( void __RPC_FAR * );

#ifndef __ITBool_INTERFACE_DEFINED__
#define __ITBool_INTERFACE_DEFINED__

/* interface ITBool */
/* [unique][helpstring][dual][uuid][object] */

EXTERN_C const IID IID_ITBool;

#if defined(__cplusplus) && !defined(CINTERFACE)

    MIDL_INTERFACE("AA0307D3-F7D5-11D2-8C80-00403338C504")
    ITBool : public IDispatch
    {
    public:
        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE Add(
            /* [in] */ IDispatch __RPC_FAR *FirstGraphic,
            /* [in] */ LPDISPATCH SecondGraphic,
            /* [retval][out] */ LPDISPATCH __RPC_FAR *ResultGraphic) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE Subtract(
            /* [in] */ IDispatch __RPC_FAR *FirstGraphic,
            /* [in] */ LPDISPATCH SecondGraphic,
            /* [retval][out] */ LPDISPATCH __RPC_FAR *ResultGraphic) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE Intersection(
            /* [in] */ IDispatch __RPC_FAR *FirstGraphic,
            /* [in] */ LPDISPATCH SecondGraphic,
            /* [retval][out] */ LPDISPATCH __RPC_FAR *ResultGraphic) = 0;

    };

#else 	/* C style interface */

    typedef struct ITBoolVtbl
    {
        BEGIN_INTERFACE

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *QueryInterface )(
            ITBool __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [iid_is][out] */ void __RPC_FAR *__RPC_FAR *ppvObject);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *AddRef )(
            ITBool __RPC_FAR * This);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *Release )(
            ITBool __RPC_FAR * This);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetTypeInfoCount )(
            ITBool __RPC_FAR * This,
            /* [out] */ UINT __RPC_FAR *pctinfo);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetTypeInfo )(
            ITBool __RPC_FAR * This,
            /* [in] */ UINT iTInfo,
            /* [in] */ LCID lcid,
            /* [out] */ ITypeInfo __RPC_FAR *__RPC_FAR *ppTInfo);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetIDsOfNames )(
            ITBool __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [size_is][in] */ LPOLESTR __RPC_FAR *rgszNames,
            /* [in] */ UINT cNames,
            /* [in] */ LCID lcid,
            /* [size_is][out] */ DISPID __RPC_FAR *rgDispId);

        /* [local] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Invoke )(
            ITBool __RPC_FAR * This,
            /* [in] */ DISPID dispIdMember,
            /* [in] */ REFIID riid,
            /* [in] */ LCID lcid,
            /* [in] */ WORD wFlags,
            /* [out][in] */ DISPPARAMS __RPC_FAR *pDispParams,
            /* [out] */ VARIANT __RPC_FAR *pVarResult,
            /* [out] */ EXCEPINFO __RPC_FAR *pExcepInfo,
            /* [out] */ UINT __RPC_FAR *puArgErr);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Add )(
            ITBool __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *FirstGraphic,
            /* [in] */ LPDISPATCH SecondGraphic,
            /* [retval][out] */ LPDISPATCH __RPC_FAR *ResultGraphic);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Subtract )(
            ITBool __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *FirstGraphic,
            /* [in] */ LPDISPATCH SecondGraphic,
            /* [retval][out] */ LPDISPATCH __RPC_FAR *ResultGraphic);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Intersection )(
            ITBool __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *FirstGraphic,
            /* [in] */ LPDISPATCH SecondGraphic,
            /* [retval][out] */ LPDISPATCH __RPC_FAR *ResultGraphic);

        END_INTERFACE
    } ITBoolVtbl;

    interface ITBool
    {
        CONST_VTBL struct ITBoolVtbl __RPC_FAR *lpVtbl;
    };

#ifdef COBJMACROS

#define ITBool_QueryInterface(This,riid,ppvObject)	\
    (This)->lpVtbl -> QueryInterface(This,riid,ppvObject)

#define ITBool_AddRef(This)	\
    (This)->lpVtbl -> AddRef(This)

#define ITBool_Release(This)	\
    (This)->lpVtbl -> Release(This)

#define ITBool_GetTypeInfoCount(This,pctinfo)	\
    (This)->lpVtbl -> GetTypeInfoCount(This,pctinfo)

#define ITBool_GetTypeInfo(This,iTInfo,lcid,ppTInfo)	\
    (This)->lpVtbl -> GetTypeInfo(This,iTInfo,lcid,ppTInfo)

#define ITBool_GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)	\
    (This)->lpVtbl -> GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)

#define ITBool_Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)	\
    (This)->lpVtbl -> Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)

#define ITBool_Add(This,FirstGraphic,SecondGraphic,ResultGraphic)	\
    (This)->lpVtbl -> Add(This,FirstGraphic,SecondGraphic,ResultGraphic)

#define ITBool_Subtract(This,FirstGraphic,SecondGraphic,ResultGraphic)	\
    (This)->lpVtbl -> Subtract(This,FirstGraphic,SecondGraphic,ResultGraphic)

#define ITBool_Intersection(This,FirstGraphic,SecondGraphic,ResultGraphic)	\
    (This)->lpVtbl -> Intersection(This,FirstGraphic,SecondGraphic,ResultGraphic)

#endif /* COBJMACROS */

#endif 	/* C style interface */

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE ITBool_Add_Proxy(
    ITBool __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *FirstGraphic,
    /* [in] */ LPDISPATCH SecondGraphic,
    /* [retval][out] */ LPDISPATCH __RPC_FAR *ResultGraphic);

void __RPC_STUB ITBool_Add_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE ITBool_Subtract_Proxy(
    ITBool __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *FirstGraphic,
    /* [in] */ LPDISPATCH SecondGraphic,
    /* [retval][out] */ LPDISPATCH __RPC_FAR *ResultGraphic);

void __RPC_STUB ITBool_Subtract_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE ITBool_Intersection_Proxy(
    ITBool __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *FirstGraphic,
    /* [in] */ LPDISPATCH SecondGraphic,
    /* [retval][out] */ LPDISPATCH __RPC_FAR *ResultGraphic);

void __RPC_STUB ITBool_Intersection_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

#endif 	/* __ITBool_INTERFACE_DEFINED__ */

#ifndef __ITRender_INTERFACE_DEFINED__
#define __ITRender_INTERFACE_DEFINED__

/* interface ITRender */
/* [unique][helpstring][dual][uuid][object] */

EXTERN_C const IID IID_ITRender;

#if defined(__cplusplus) && !defined(CINTERFACE)

    MIDL_INTERFACE("534AC505-0777-11D3-8C87-00403338C504")
    ITRender : public IDispatch
    {
    public:
        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE DoRenderAll(
            /* [in] */ IDispatch __RPC_FAR *WhichView) = 0;

    };

#else 	/* C style interface */

    typedef struct ITRenderVtbl
    {
        BEGIN_INTERFACE

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *QueryInterface )(
            ITRender __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [iid_is][out] */ void __RPC_FAR *__RPC_FAR *ppvObject);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *AddRef )(
            ITRender __RPC_FAR * This);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *Release )(
            ITRender __RPC_FAR * This);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetTypeInfoCount )(
            ITRender __RPC_FAR * This,
            /* [out] */ UINT __RPC_FAR *pctinfo);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetTypeInfo )(
            ITRender __RPC_FAR * This,
            /* [in] */ UINT iTInfo,
            /* [in] */ LCID lcid,
            /* [out] */ ITypeInfo __RPC_FAR *__RPC_FAR *ppTInfo);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetIDsOfNames )(
            ITRender __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [size_is][in] */ LPOLESTR __RPC_FAR *rgszNames,
            /* [in] */ UINT cNames,
            /* [in] */ LCID lcid,
            /* [size_is][out] */ DISPID __RPC_FAR *rgDispId);

        /* [local] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Invoke )(
            ITRender __RPC_FAR * This,
            /* [in] */ DISPID dispIdMember,
            /* [in] */ REFIID riid,
            /* [in] */ LCID lcid,
            /* [in] */ WORD wFlags,
            /* [out][in] */ DISPPARAMS __RPC_FAR *pDispParams,
            /* [out] */ VARIANT __RPC_FAR *pVarResult,
            /* [out] */ EXCEPINFO __RPC_FAR *pExcepInfo,
            /* [out] */ UINT __RPC_FAR *puArgErr);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *DoRenderAll )(
            ITRender __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *WhichView);

        END_INTERFACE
    } ITRenderVtbl;

    interface ITRender
    {
        CONST_VTBL struct ITRenderVtbl __RPC_FAR *lpVtbl;
    };

#ifdef COBJMACROS

#define ITRender_QueryInterface(This,riid,ppvObject)	\
    (This)->lpVtbl -> QueryInterface(This,riid,ppvObject)

#define ITRender_AddRef(This)	\
    (This)->lpVtbl -> AddRef(This)

#define ITRender_Release(This)	\
    (This)->lpVtbl -> Release(This)

#define ITRender_GetTypeInfoCount(This,pctinfo)	\
    (This)->lpVtbl -> GetTypeInfoCount(This,pctinfo)

#define ITRender_GetTypeInfo(This,iTInfo,lcid,ppTInfo)	\
    (This)->lpVtbl -> GetTypeInfo(This,iTInfo,lcid,ppTInfo)

#define ITRender_GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)	\
    (This)->lpVtbl -> GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)

#define ITRender_Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)	\
    (This)->lpVtbl -> Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)

#define ITRender_DoRenderAll(This,WhichView)	\
    (This)->lpVtbl -> DoRenderAll(This,WhichView)

#endif /* COBJMACROS */

#endif 	/* C style interface */

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE ITRender_DoRenderAll_Proxy(
    ITRender __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *WhichView);

void __RPC_STUB ITRender_DoRenderAll_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

#endif 	/* __ITRender_INTERFACE_DEFINED__ */

#ifndef __TCADEXLib_LIBRARY_DEFINED__
#define __TCADEXLib_LIBRARY_DEFINED__

/* library TCADEXLib */
/* [helpstring][version][uuid] */

EXTERN_C const IID LIBID_TCADEXLib;

EXTERN_C const CLSID CLSID_TBool;

#ifdef __cplusplus

class DECLSPEC_UUID("AA0307D4-F7D5-11D2-8C80-00403338C504")
TBool;
#endif

EXTERN_C const CLSID CLSID_TRender;

#ifdef __cplusplus

class DECLSPEC_UUID("534AC506-0777-11D3-8C87-00403338C504")
TRender;
#endif
#endif /* __TCADEXLib_LIBRARY_DEFINED__ */

/* Additional Prototypes for ALL interfaces */

/* end of Additional Prototypes */

#ifdef __cplusplus
}
#endif

#endif


Examples - C++ Server - TRender.cpp

TRender.cpp

C++ Server Example

// TRender.cpp : Implementation of CTRender
#include "stdafx.h"
#include "TCADEX.h"
#include "TRender.h"

/////////////////////////////////////////////////////////////////////////////
// CTRender

BOOL CTRender::Init()
{
    if (!m_bInit)
    {
        m_hDBAPI = GetModuleHandle(DBAPI);
        if (m_hDBAPI != NULL)
        {

            m_pfRenderGetDefaultRender = (RENDERGETDEFAULTRENDER)GetProcAddress(m_hDBAPI, "RenderGetDefaultRender");
            m_pfRenderSceneNew = (RENDERSCENENEW)GetProcAddress(m_hDBAPI, "RenderSceneNew");
            m_pfRenderSceneBeginRender = (RENDERSCENEBEGINRENDER)	GetProcAddress(m_hDBAPI, "RenderSceneBeginRender");
            m_pfRenderCountRenders = (RENDERCOUNTRENDERS)	GetProcAddress(m_hDBAPI, "RenderCountRenders");
            m_pfRenderSceneDoRender = (RENDERSCENEDORENDER) GetProcAddress(m_hDBAPI, "RenderSceneDoRender");

            m_pfDrawingGetActiveViewport = (DRAWINGGETACTIVEVIEWPORT)GetProcAddress(m_hDBAPI, "DrawingGetActiveViewport");
///			m_pfViewportGetDispatch = (VIEWPORTGETDISPATCH)GetProcAddress(m_hDBAPI, "ViewportGetDispatch");
///			m_pfnGrGetDispatch = (GRAPHICGETDISPATCH)GetProcAddress(m_hDBAPI, "GraphicGetDispatch");
            if (m_pfDrawingGetActiveViewport != NULL
                && m_pfRenderGetDefaultRender != NULL && m_pfRenderSceneBeginRender != NULL
                && m_pfRenderCountRenders != NULL && m_pfRenderSceneDoRender != NULL)

                m_bInit = TRUE;
        }
    }
    return m_bInit;

}

const IID IID_View = {0x6A481110, 0xE531, 0x11CF, {0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

STDMETHODIMP CTRender::DoRenderAll(IDispatch *WhichView)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;

    IDrawing *pIDwg = NULL;
    View *pView = NULL;

    long hwndView = NULL;
    long hwndDrawing = NULL;
    long lDwg = 0;
    long lView = 0;
    if (Init())
    {

        try
        {

            hRes = WhichView->QueryInterface(IID_View, (void**)&pView);
            CHECK_HRESULT(hRes)

            hRes = pView->get_Drawing(&pIDwg);
            CHECK_HRESULT(hRes)

    //		pView = GetActiveView(pIDwg);
    //		if (pView == NULL)
    //			throw hRes;

            long lVp = 0;

            hRes = pIDwg->get__Handle(&lDwg);
            CHECK_HRESULT(hRes)

            lVp = (*m_pfDrawingGetActiveViewport)(lDwg);
    //		if (lVp == 0)
    //				throw hRes = E_FAIL;

    //		int renderCount = (int) (*pfRenderCountRenders)();
    //		renderCount = 0;
            int renderId = (int)(*m_pfRenderGetDefaultRender)();
            int flag = 0;
            int sceneId = (int)(*m_pfRenderSceneNew)(lVp, lDwg, renderId, flag, NULL);

            long res = 0;

            res = (long)(*m_pfRenderSceneBeginRender)(sceneId);

            long res1 = 0;

            res1 = (long) (*m_pfRenderSceneDoRender)(sceneId, lVp, NULL, NULL);

    //		renderCount = (int) (*pfRenderCountRenders)();

        }

        catch (...)
        {
            TRACE_EXCEPTION("CTRender::DoRenderAll")
            _clearfp();
        }
    }
    RELEASE(pView)

    return hRes;
}


Examples - C++ Server - TRender.h

TRender.h

C++ Server Example

// TRender.h : Declaration of the CTRender

#ifndef __TRENDER_H_
#define __TRENDER_H_

#include "resource.h"       // main symbols

/////////////////////////////////////////////////////////////////////////////
// CTRender
class ATL_NO_VTABLE CTRender :
    public CComObjectRootEx<CComSingleThreadModel>,
    public CComCoClass<CTRender, &CLSID_TRender>,
    public IDispatchImpl<ITRender, &IID_ITRender, &LIBID_TCADEXLib>
{
    RENDERGETDEFAULTRENDER m_pfRenderGetDefaultRender;
    RENDERSCENENEW m_pfRenderSceneNew;
    RENDERSCENEBEGINRENDER m_pfRenderSceneBeginRender;
    RENDERCOUNTRENDERS	m_pfRenderCountRenders;
    RENDERSCENEDORENDER	m_pfRenderSceneDoRender;
    DRAWINGGETACTIVEVIEWPORT	m_pfDrawingGetActiveViewport;

public:
    CTRender()
    {
        m_pfRenderGetDefaultRender = NULL;
        m_pfRenderSceneNew = NULL;
        m_pfRenderSceneBeginRender = NULL;
        m_pfRenderCountRenders = NULL;
        m_pfRenderSceneDoRender = NULL;
        m_hDBAPI = NULL;
        m_bInit = NULL;

    }

DECLARE_REGISTRY_RESOURCEID(IDR_TRENDER)

DECLARE_PROTECT_FINAL_CONSTRUCT()

BEGIN_COM_MAP(CTRender)
    COM_INTERFACE_ENTRY(ITRender)
    COM_INTERFACE_ENTRY(IDispatch)
END_COM_MAP()

// ITRender
public:
    STDMETHOD(DoRenderAll)(/*[in]*/ IDispatch *WhichView);
    BOOL Init();
    HINSTANCE m_hDBAPI;
    BOOL m_bInit;
};

#endif //__TRENDER_H_


Examples - C++ Insert External Symbol Tool - ExSymbol.cpp

ExSymbol.cpp

C++ Insert External Symbol Tool Example

// ExSymbol.cpp : Implementation of CExSymbol
#include "stdafx.h"
#include "InsertExternalSymbol.h"
#include "ExSymbol.h"
#include "xdbtool_i.c"

/////////////////////////////////////////////////////////////////////////////
// CExSymbol

/////////////////////////////////////////////////////////////////////////////
// CExSymbol

COleVariant t(-1L, VT_BOOL);
COleVariant f(0L, VT_BOOL);
COleVariant missing((long)DISP_E_PARAMNOTFOUND, VT_ERROR);
const IID IID_Tool = {0x6A48112C,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const CLSID CLSID_XGraphic  = {0x6A481803,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_Graphics = {0x6A48110A, 0xE531, 0x11CF, {0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
//const IID_IToolEvents = {0x0C926530,0x68C5,0x11d2, {0x8D,0x5E,0x00,0x00,0x21,0x45,0x2D,0xB6}};

STDMETHODIMP CExSymbol::get_ClassID(BSTR *pVal)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;
    LPOLESTR olestr = NULL;

    try
    {
        if(SUCCEEDED( ::StringFromCLSID(CLSID_ExSymbol, &olestr)))
        {

            *pVal = ::SysAllocString(olestr);
            hRes = S_OK;
        }
    }
    catch (...)
    {
        TRACE_EXCEPTION("CExSymbol::get_ClassID")
    }

    if (olestr != NULL)
    CoTaskMemFree(olestr);

    return hRes;
}

STDMETHODIMP CExSymbol::get_Description(BSTR *pVal)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    HRESULT hRes = E_FAIL;
    // TODO: Add your implementation code here
    // Get the description from the resource
    CString strResult;
    if (strResult.LoadString(IDS_DESCRIPTION))
    {
        hRes = S_OK;
        *pVal = strResult.AllocSysString();
    }
    return hRes;
}
STDMETHODIMP CExSymbol::GetToolInfo(VARIANT *CommandNames, VARIANT *MenuCaptions, VARIANT *StatusPrompts, VARIANT *ToolTips, VARIANT *Enabled, VARIANT *WantsUpdates, long *ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;

    SAFEARRAYBOUND bound = {NUM_TOOLS, 0};

    CString cstrText;
    CString cstrTextTemp;

    BSTR bstrCommandName = NULL;
    BSTR bstrMenuCaption = NULL;
    BSTR bstrStatusPrompt = NULL;
    BSTR bstrToolTip = NULL;
    BOOL bEnabled = TRUE;
    BOOL bWantsUpdates = TRUE;

    long lIndicies = 0;
    try
    {

        hRes = SafeArrayRedim(CommandNames->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(MenuCaptions->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(StatusPrompts->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(ToolTips->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(Enabled->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(WantsUpdates->parray, &bound);
        CHECK_HRESULT(hRes)

// AALB 141199		CString cstrText="Insert|Dimension|Tolerance";
        cstrText.LoadString (IDS_MAINMENU);
        cstrText.Insert(cstrText.GetLength (), '|');
        cstrTextTemp.LoadString (IDS_SUBMENU);
        cstrText.Insert(cstrText.GetLength (), cstrTextTemp);
        cstrText.Insert(cstrText.GetLength (), '|');
        cstrTextTemp.LoadString (IDS_MENUCAPTION);
        cstrText.Insert(cstrText.GetLength (), cstrTextTemp);
        cstrTextTemp.Empty ();

        bstrCommandName = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(CommandNames->parray, &lIndicies, (void *)bstrCommandName);
        CHECK_HRESULT(hRes)

        cstrText.Empty ();
        cstrText.LoadString (IDS_MENUCAPTION);
        bstrMenuCaption = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(MenuCaptions->parray, &lIndicies, (void *)bstrMenuCaption);
        CHECK_HRESULT(hRes)
        cstrText.Empty ();

         cstrText.LoadString (IDS_PROMT0);
        bstrStatusPrompt = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(StatusPrompts->parray, &lIndicies, (void *)bstrStatusPrompt);
        CHECK_HRESULT(hRes)
        cstrText.Empty ();

        cstrText.LoadString (IDS_TOOLTIPS);;
        bstrToolTip = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(ToolTips->parray, &lIndicies, (void *)bstrToolTip);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayPutElement(Enabled->parray, &lIndicies, (void *)&bEnabled);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayPutElement(WantsUpdates->parray, &lIndicies, (void *)&bWantsUpdates);
        CHECK_HRESULT(hRes)

        *ret = NUM_TOOLS;
    }
    catch (...)
    {
        if (SUCCEEDED(hRes))
            hRes = E_FAIL;
        TRACE_EXCEPTION("CExSymbol::GetToolInfo")
    }
    return hRes;
}

STDMETHODIMP CExSymbol::CopyBitmap(VARIANT_BOOL LargeButtons, VARIANT_BOOL Monochrome, VARIANT_BOOL *ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    return S_OK;
}
STDMETHODIMP CExSymbol::GetPicture(VARIANT_BOOL LargeButtons, VARIANT_BOOL Monochrome, IDispatch **ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    LPTSTR IDB = 0;

    HRESULT hRes = E_FAIL;
    //	CBitmap pBmp;
    try
    {
//		pBmp.LoadBitmap (IDB_BMP1);
        if(LargeButtons)
        {
            IDB = MAKEINTRESOURCE(IDB_BMP2);
        }
        else
        {
            IDB = MAKEINTRESOURCE(IDB_BMP1);
        }
        HBITMAP pBmp = ::LoadBitmap(AfxGetResourceHandle(), IDB);

        PICTDESC pict;
        pict.cbSizeofstruct = sizeof(pict);
        pict.picType = PICTYPE_BITMAP;
        pict.bmp.hbitmap = pBmp;
        pict.bmp.hpal = NULL;

        hRes = OleCreatePictureIndirect(&pict, IID_IDispatch, TRUE, (void**)ret);

        CHECK_HRESULT(hRes)
        hRes = S_OK;

    }

    catch (...)
    {
        TRACE_EXCEPTION("CExSymbol::GetPicture")
    }

    return S_OK;
}

STDMETHODIMP CExSymbol::Run(IDispatch *ThisTool, VARIANT_BOOL *ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;

    Tool *pTool = NULL;
    IApplication *pIApp = NULL;
    Graphics* pGrs = NULL;
    IDrawing *pDr = NULL;
    RegenMethods *pRms = NULL;
    RegenMethod *pRm = NULL;

    COleVariant varAperture(0.2);

    COleVariant varOptional(varMissing);

    COleVariant varItem = (0L);
    COleVariant varRegen("Roughness.ANSI");

    CString cstrText;
    BSTR bstrStatusPrompt;
    cstrText.LoadString (IDS_PROMT);
    bstrStatusPrompt = cstrText.AllocSysString();
    m_bDragging  = FALSE;

    COleVariant varProp;
    Properties *pProps = NULL;
    Property *pProp = NULL;

    try
    {
        hRes = ThisTool->QueryInterface(IID_Tool, (void **)&m_pTool);
        CHECK_HRESULT(hRes)

        hRes = m_pTool->get_Application(&m_pIApplication);
        CHECK_HRESULT(hRes)

        BSTR bstrFileName;

        hRes = m_pIApplication->get_ActiveDrawing(&pDr);

        CHECK_HRESULT(hRes)
        hRes = m_pIApplication->GetOpenFilename(&varMissing, &varMissing, &varMissing, &varMissing, &bstrFileName);

        if (FAILED(hRes))
        {
            Destroy();
            return hRes;

        }

        IDrawing *pDrSymb = NULL;
        Drawings *pDrs = NULL;
        Graphics *pGrsSymb = NULL;
        IGraphic *pGrTmp = NULL;
        long lCount;
        long n = 0;

        IGraphic *pGrCur = NULL;
        COleVariant varType((const long)imsiGroup);
        Graphics *pDragGrGrs = NULL;
        COleVariant varItem(0L);
        varItem.vt = VT_I4;

        COleVariant varItemTmp(0L);
        varItemTmp.vt = VT_I4;

        hRes = m_pIApplication->get_Drawings(&pDrs);
        CHECK_HRESULT(hRes)
// ----------------------  make the symbol graphic
        hRes = pDrs->Open(bstrFileName, &t, &varMissing, &pDrSymb);
        CHECK_HRESULT(hRes)

        hRes = pDrSymb->get_Graphics(&pGrsSymb);
        CHECK_HRESULT(hRes)

        hRes = pGrsSymb->Add(&varType,
                             &varMissing,
                             &varOptional,
                             &varOptional,
                             &varOptional,
                             &varOptional,
                             &m_pDragGraphic);
        CHECK_HRESULT(hRes)

        hRes = pGrsSymb->get_Count(&lCount);
        CHECK_HRESULT(hRes)

        hRes = m_pDragGraphic->get_Graphics(&pDragGrGrs);
        CHECK_HRESULT(hRes)

// be sure that all graphics in drawing that contains symbol are placed on one layer otherwise this code will not work correctly
// (you will get GPF
        for (n = 0; n < lCount - 1; n++)
        {

            long lTmp;
            varItem = n;
            hRes = pGrsSymb->get_Item(&varItem, &pGrCur);

            hRes = pGrCur->Duplicate(&pGrTmp);
            hRes = pGrTmp->get_Index(&lTmp);
            varItemTmp = lTmp;

            hRes = pGrsSymb->Remove(varItemTmp, &pGrTmp);

            hRes = pDragGrGrs->AddGraphic(pGrTmp, &varMissing, &varMissing);

            RELEASE(pGrCur)
            RELEASE(pGrTmp)
        }
//		RELEASE(pDragGrGrs)

        hRes = QueryInterface(IID_IExSymbol, (void**)&m_pITool);
        CHECK_HRESULT(hRes)

        hRes = m_pIApplication->QueryInterface(IID_IToolEvents, (void **)&m_pIToolEvents);
        hRes = m_pIToolEvents->ToolChangePrompt(m_pITool,bstrStatusPrompt , FALSE);

        ConnectEvents(m_pITool);
        m_bRunned = FALSE;//TRUE;

        hRes = pDr->get_Graphics(&pGrs);
        CHECK_HRESULT(hRes)

        long index;
        hRes = m_pDragGraphic->get_Index(&index);
        varItem = index;
        hRes = pGrsSymb->Remove(&varItem, &m_pDragGraphic);
        CHECK_HRESULT(hRes)

        hRes = pDrSymb->Close(&varOptional, &varOptional, &varOptional);
        RELEASE(pDrSymb)
//----------------------------------------------------------------
        *ret = TRUE;
        hRes = S_OK;
    }
    catch (...)
    {
        TRACE_EXCEPTION("CExSymbol::Run")
    }

    RELEASE(pIApp)
    RELEASE(pGrs)
    RELEASE(pDr)
    RELEASE(pRm)
        //	RELEASE(pTool)
    return hRes;
}

STDMETHODIMP CExSymbol::UpdateToolStatus(IDispatch *ThisTool, VARIANT_BOOL *Enabled, VARIANT_BOOL *Checked, VARIANT_BOOL *ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;

    try
    {
        if (m_bRunned)
            *Checked = TRUE;
        *ret = TRUE;
        hRes = S_OK;

    }
    catch (...)
    {
        TRACE_EXCEPTION("CExSymbol::UpdateToolStatus")
    }
    return hRes;
}

STDMETHODIMP CExSymbol::Initialize(IDispatch *ThisTool, VARIANT_BOOL *ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    m_bRunned = FALSE;
    m_pIApplication = NULL;
    m_pITool = NULL;
    m_pTool = NULL;
    m_dwEventConnection = NULL;
    m_pDragGraphic = NULL;
    m_bDragging  = FALSE;
    m_pView = NULL;
    g_hDBAPI = NULL;
    m_bInit = FALSE;
    m_bUndoInit = FALSE;
    m_pIToolEvents = NULL;

    return S_OK;
}

STDMETHODIMP CExSymbol::Terminate(IDispatch *ThisTool)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    return S_OK;
}
STDMETHODIMP CExSymbol::BeforeExit(IDispatch *TheApp, VARIANT_BOOL *Cancel)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    return S_OK;
}

STDMETHODIMP CExSymbol::RunTool(IDispatch *ThisTool)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;

    try
    {
        Destroy();
        hRes = S_OK;
    }

    catch (...)
    {

        TRACE_EXCEPTION("CExSymbol::RunTool")

    }

    return hRes;

}

STDMETHODIMP CExSymbol::MouseDown(IDispatch *WhichDrawing, IDispatch *WhichView, IDispatch *WhichWindow, short Button, long Shift, long X, long Y, VARIANT_BOOL *Cancel)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    *Cancel = TRUE;
    HRESULT hRes = E_FAIL;
    COleVariant varOptional(varMissing);

    CPoint point;
    point.x = X;
    point.y = Y;

    View *pView = NULL;
    pView = (View*)WhichView;
    pView->AddRef();

    double xW, yW, zW, z;
    double x, y, x1, y1, z1;
    Graphics *pGrs = NULL;
    IDrawing *pDr = NULL;
    pDr = (IDrawing*)WhichDrawing;
    pDr->AddRef();
    IGraphic *pGr = NULL;
    long result;
    long lD = 0;
    long lGrId = 0;
    z = 0;
    CString cstrUndo;
//	cstrUndo.LoadString (IDS_UNDORECORD);;

    try
    {
        if (Button == 1)
        {

            hRes = pDr->get_Graphics(&pGrs);
            CHECK_HRESULT(hRes)

            hRes = pGrs->AddGraphic(m_pDragGraphic, varOptional, varOptional);
            CHECK_HRESULT(hRes)

            hRes = m_pDragGraphic->Update();
            CHECK_HRESULT(hRes)

            hRes = m_pDragGraphic->get__Handle(&lGrId);

            EndDrag(point);

            m_pView->Refresh();

        }

        hRes = S_OK;
    }
    catch (...)
    {

        TRACE_EXCEPTION("CExSymbol::MouseDown")

    }

    RELEASE(pView)
    RELEASE(pGr)
    RELEASE(pGrs)
    RELEASE(pDr)
    Destroy();
    return S_OK;

}

STDMETHODIMP CExSymbol::MouseUp(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y, IMSI_BOOL *pbCancel)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    *pbCancel = TRUE;
    return S_OK;

}
STDMETHODIMP CExSymbol::MouseMove(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, long Shift, long X, long Y, IMSI_BOOL *pbCancel)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    HRESULT hRes = E_FAIL;
    *pbCancel = FALSE;

    CPoint point;
    point.x = X;
    point.y = Y;

    View *pView = NULL;
    IDrawing *pDr = NULL;
    pDr = (IDrawing*)WhichDrawing;
    pDr->AddRef();

    try
    {

        if (!m_bDragging)
        {
            m_pView = (View*)WhichView;
            m_pView->AddRef();
            BeginDrag(point);
        }
        else
        {

            pView = (View*)WhichView;
            pView->AddRef();
            ASSERT(m_pView);
            if (pView != m_pView)
            {
//				pView->Refresh();
                RELEASE(pView)
                RELEASE(m_pView)

                m_pView = (View*)WhichView;
                m_pView->AddRef();
                RestartDrag(point);
//				m_pView->Refresh();
            }

            Drag(point);
        }

    }

    catch (...)
    {

        TRACE_EXCEPTION("CExSymbol::MouseMove")

    }

    return S_OK;

}
STDMETHODIMP CExSymbol::SelectionChange(IDispatch *WhichDrawing, IDispatch *WhichView, IDispatch *WhichWindow, IDispatch *Sel)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    return S_OK;
}

STDMETHODIMP CExSymbol::PointSnapped(IDispatch *WhichDrawing, IDispatch *WhichView, long X, long Y, IDispatch *PointRaw, IDispatch *PointSnapped)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    return S_OK;
}

void CExSymbol::ConnectEvents(IDispatch *ThisTool)
{

     HRESULT hRes = S_OK;

    if (m_dwEventConnection != 0)
    {
//		AfxMessageBox("Already connected.");
        return;
    }

    try
    {

        DWORD dwEventMask = imsiEventMouseUp
//							 | imsiEventSelectionChange
                             | imsiEventMouseMove
                             | imsiEventMouseDown
                             | imsiEventDrawingDeactivate
                             | imsiEventRunTool
                             | imsiEventBeforeExit;
//							 | imsiEventMouseMove;
//							 | imsiEventPointSnapped;

        COleVariant var((long)dwEventMask);
        hRes = m_pIApplication->ConnectEvents(ThisTool,
            &var,
            (long*)&m_dwEventConnection);

        if (FAILED(hRes))
        {
    //		AfxMessageBox("Connection not established.");
            return;
        }
    }
    catch (...)
    {
        TRACE_EXCEPTION("CExSymbol::ConnectEvents")
    }

}

void CExSymbol::DisconnectEvents()
{

    if (m_pIApplication == NULL || m_dwEventConnection == 0)
        return;
    try
    {

        HRESULT	hRes = m_pIApplication->DisconnectEvents(m_dwEventConnection);
        CHECK_HRESULT(hRes)
        if (FAILED(hRes))
        {
//			AfxMessageBox("Connection not broken.");
            return;

        }
        m_dwEventConnection = 0;

    }

    catch (...)
    {
        TRACE_EXCEPTION("CExSymbol::DisconnectEvents")
    }
//	if(m_pIApplication != NULL)
//	{
//		m_pIApplication->Release();
//		m_pIApplication = NULL;
//	}

}

///------------------------------------------
// DragOutline functions
BOOL CExSymbol::BeginDrag(const CPoint& point)
{
    VariantClear(&m_dragOutline);
    SAFEARRAYBOUND bound;
    bound.cElements = 0;
    bound.lLbound = 0;
    m_dragOutline.vt = VT_ARRAY|VT_R8;
    m_dragOutline.parray = ::SafeArrayCreate(VT_R8, 1, &bound);

    BoundingBox* Box = NULL;
    IVertex* vMax = NULL;
    IVertex* vMin = NULL;
    double x, y, x1, y1;
    x = x1 = y = y1 = 0;
    try
    {
        HRESULT hRes = m_pDragGraphic->CreateDragOutline(&m_dragOutline);
        CHECK_HRESULT(hRes)

        m_bDragging = TRUE;
        m_pDragGraphic->put_Visible(FALSE);
        VARIANT varState;
        varState.vt = VT_I4;
        varState.lVal = imsiDragBegin;

        hRes = m_pDragGraphic->CalcBoundingBox(NULL, &Box);
        CHECK_HRESULT(hRes)

        hRes = Box->get_Max(&vMax);
        CHECK_HRESULT(hRes)

        hRes = Box->get_Min(&vMin);
        CHECK_HRESULT(hRes)

        hRes = vMax->get_X(&x);
        CHECK_HRESULT(hRes)

        hRes = vMax->get_Y(&y);
        CHECK_HRESULT(hRes)

        hRes = vMin->get_X(&x1);
        CHECK_HRESULT(hRes)

        hRes = vMin->get_Y(&y1);
        CHECK_HRESULT(hRes)

        x = x1 + (x - x1)/2;
        y = y1 + (y - y1)/2;
        hRes = m_pView->ViewToScreen(x, y, &x1, &y1, NULL);
        CHECK_HRESULT(hRes)

        hRes = m_pView->DragOutline(&m_dragOutline, x1, y1, &varState);
        CHECK_HRESULT(hRes)

        varState.lVal = imsiDragContinue;
        hRes = m_pView->DragOutline(&m_dragOutline, point.x, point.y, &varState);
        CHECK_HRESULT(hRes)
    }
    catch (...)
    {
        TRACE_EXCEPTION("CExSymbol::BeginDrag")
    }
    RELEASE(vMin)
    RELEASE(vMax)
    RELEASE(Box)

    return TRUE;
}

void CExSymbol::Drag(const CPoint& point)
{
    if (m_pView == NULL)
        return;

    VARIANT varState;
    varState.vt = VT_I4;
    varState.lVal = imsiDragContinue;

    try
    {
        HRESULT hRes = m_pView->DragOutline(&m_dragOutline, point.x, point.y, &varState);
        CHECK_HRESULT(hRes)
    }
    catch (...)
    {
        TRACE_EXCEPTION("CExSymbol::Drag")
    }

}
void CExSymbol::EndDrag(const CPoint& point)
{
    m_bDragging = FALSE;
    if (m_pView == NULL || m_pDragGraphic == NULL)
        return;

    VARIANT varState;
    varState.vt = VT_I4;
    varState.lVal = imsiDragEnd;
    IMatrix *pMat = NULL;

    try
    {
        HRESULT hRes = m_pView->DragOutline(&m_dragOutline, point.x, point.y, &varState);
        CHECK_HRESULT(hRes)

        VariantClear(&m_dragOutline);

        double dx, dy, dz;
        dx = dy = dz = 0;

        double dxWorld, dyWorld, dzWorld;
        dxWorld = dyWorld = dzWorld = 0;
        hRes = m_pView->ScreenToView(point.x, point.y, &dx, &dy);
        CHECK_HRESULT(hRes)

        VARIANT var;
        var.vt = VT_ERROR;
        var.scode = DISP_E_PARAMNOTFOUND;

        ImsiSpaceModeType curMode;

        hRes = m_pView->get_SpaceMode(&curMode);
        CHECK_HRESULT(hRes)
        dxWorld = dx;
        dyWorld = dy;

        if(curMode == imsiModelSpace)
        {
            hRes = m_pView->ViewToWorld(dx, dy, dz, &dxWorld, &dyWorld, &dzWorld);
            CHECK_HRESULT(hRes)
        }
        hRes = m_pDragGraphic->MoveAbsolute(dxWorld, dyWorld, 0, &var, &var, &var, &pMat);
        CHECK_HRESULT(hRes)
        hRes = m_pDragGraphic->put_Visible(TRUE);
//		hRes = m_pDragGraphic->Update();
//		CHECK_HRESULT(hRes)
//		hRes = m_pDragGraphic->Draw((VARIANT*)m_pView);

    }
    catch (...)
    {
        TRACE_EXCEPTION("CExSymbol::EndDrag")
    }

    RELEASE(pMat)
    RELEASE(m_pDragGraphic)

}

void CExSymbol::RestartDrag(const CPoint& point)
{
    try
    {
        m_bDragging = FALSE;
        VARIANT varState;
        varState.vt = VT_I4;
        varState.lVal = imsiDragEnd;
        HRESULT hRes = m_pView->DragOutline(&m_dragOutline, point.x, point.y, &varState);
        CHECK_HRESULT(hRes)

        VariantClear(&m_dragOutline);
        BeginDrag(point);
    }
    catch (...)
    {
        TRACE_EXCEPTION("CExSymbol::RestartDrag")
    }

}

void CExSymbol::Destroy()
{
//	RELEASE(m_pView)

    CString cstrT;
    cstrT.Empty ();
    BSTR bstrPromt = NULL;
    bstrPromt = cstrT.AllocSysString ();
    m_pIToolEvents->ToolChangePrompt(m_pITool,bstrPromt, FALSE);

    RELEASE(m_pIToolEvents)
    DisconnectEvents();
    RELEASE(m_pDragGraphic);
    RELEASE(m_pITool);
    RELEASE(m_pIApplication);
    RELEASE(m_pTool);

    m_bRunned = FALSE;

}

STDMETHODIMP CExSymbol::DrawingBeforeClose(LPDISPATCH WhichDrawing, VARIANT_BOOL *Cancel)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here
    HRESULT hRes = E_FAIL;
    Drawings *pDrs = NULL;
    long n = 0;
    *Cancel = FALSE;

    try
    {
        hRes = m_pIApplication->get_Drawings(&pDrs);
        CHECK_HRESULT(hRes)
        hRes = pDrs->get_Count(&n);
        CHECK_HRESULT(hRes)

        if (n == 1)
        {
            Destroy();
        }

    }

    catch (...)
    {
        TRACE_EXCEPTION("CExSymbol::DrawingBeforeClose")
    }

    RELEASE(pDrs)

    return S_OK;
}
STDMETHODIMP CExSymbol::DrawingDeactivate( IDispatch *WhichDrawing)
{
//	Destroy();
    return S_OK;
}

BOOL CExSymbol::Init()
{
    m_bInit = true;
    return m_bInit;
}
/*
    m_bInit = FALSE;
    m_bUndoInit = FALSE;
    g_hDBAPI = GetModuleHandle(DBAPI70);
    if (g_hDBAPI == NULL)
    {
        g_hDBAPI = GetModuleHandle(DBAPI60);
        if (g_hDBAPI == NULL)
        {
            g_hDBAPI = GetModuleHandle(DBAPI50);
        }
    }
    if (g_hDBAPI != NULL)
    {
        g_pfnRegenMethodDoAutoPage = (REGENMETHODDOAUTOPAGE)GetProcAddress(g_hDBAPI,"RegenMethodDoAutoPage");
        g_pfnAppGetCurrentApp = (APPGETCURRENTAPP)GetProcAddress(g_hDBAPI,"AppGetCurrentApp");
        if(g_pfnRegenMethodDoAutoPage != NULL && g_pfnAppGetCurrentApp != NULL)
            m_bInit = TRUE;

        g_pfnUndoStart = (UNDOENGINESTARTRECORD)GetProcAddress(g_hDBAPI,"UndoEngineStartRecord");
        g_pfnUndoEnd = (UNDOENGINEENDRECORD)GetProcAddress(g_hDBAPI,"UndoEngineEndRecord");
        g_pfnUndoRecordAddGraphic = (UNDOENGINEADDGRAPHIC)GetProcAddress(g_hDBAPI,"UndoEngineAddGraphic");
        if(g_pfnUndoStart != NULL && g_pfnUndoEnd != NULL && g_pfnUndoRecordAddGraphic != NULL)
            m_bUndoInit = TRUE;

    }

    return m_bInit;
}
*/


Examples - C++ Insert External Symbol Tool - ExSymbol.h

ExSymbol.h

C++ Insert External Symbol Tool Example

// ExSymbol.h : Declaration of the CExSymbol

#ifndef __EXSYMBOL_H_
#define __EXSYMBOL_H_

#include "resource.h"       // main symbols

/////////////////////////////////////////////////////////////////////////////
// CExSymbol
class ATL_NO_VTABLE CExSymbol :
    public CComObjectRootEx<CComSingleThreadModel>,
    public CComCoClass<CExSymbol, &CLSID_ExSymbol>,
    public IDispatchImpl<IExSymbol, &IID_IExSymbol, &LIBID_INSERTEXTERNALSYMBOLLib>
{
public:
    CExSymbol()
    {
    }

DECLARE_REGISTRY_RESOURCEID(IDR_EXSYMBOL)

DECLARE_PROTECT_FINAL_CONSTRUCT()

BEGIN_COM_MAP(CExSymbol)
    COM_INTERFACE_ENTRY(IExSymbol)
    COM_INTERFACE_ENTRY(IDispatch)
END_COM_MAP()

// IExSymbol
public:
    Tool* m_pTool;
    IExSymbol* m_pITool;
    IToolEvents* m_pIToolEvents;

    BOOL m_bRunned;
    BOOL m_bInit;
    BOOL m_bUndoInit;
    IApplication* m_pIApplication;
    DWORD m_dwEventConnection;
    HINSTANCE g_hDBAPI;
    HINSTANCE g_hTCAPI;

    void DisconnectEvents();
    void ConnectEvents(IDispatch *ThisTool);
    BOOL BeginDrag(const CPoint& point);
    void Drag(const CPoint& point);
    void RestartDrag(const CPoint& point);
    void EndDrag(const CPoint& point);
    void Destroy();
    BOOL Init();
    VARIANT m_dragOutline;
    IGraphic* m_pDragGraphic;
    BOOL m_bDragging;
    View* m_pView;

    STDMETHOD(get_Description)(/*[out, retval]*/ BSTR *pVal);
    STDMETHOD(get_ClassID)(/*[out, retval]*/ BSTR *pVal);
    STDMETHOD(MouseDown)(/*[in]*/IDispatch *WhichDrawing, /*[in]*/IDispatch *WhichView, /*[in]*/IDispatch *WhichWindow, /*[in]*/short Button, /*[in]*/long Shift, /*[in]*/long X, /*[in]*/long Y, /*[in, out]*/VARIANT_BOOL *Cancel);
    STDMETHOD(MouseMove)(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, long Shift, long X, long Y, IMSI_BOOL* pbCancel);
    STDMETHOD(MouseUp)(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel);
    STDMETHOD(SelectionChange)(/*[in]*/ IDispatch *WhichDrawing, /*[in]*/ IDispatch *WhichView, /*[in]*/  IDispatch *WhichWindow, /*[in]*/ IDispatch *Sel );
    STDMETHOD(RunTool)(/*[in]*/ IDispatch * ThisTool);
    STDMETHOD(BeforeExit)(/*[in]*/ IDispatch* TheApp, /*[in, out]*/ VARIANT_BOOL* Cancel);
    STDMETHOD(Terminate)(/*[in]*/ IDispatch * ThisTool);
    STDMETHOD(Initialize)(/*[in]*/ IDispatch * ThisTool, /*[out, retval]*/ VARIANT_BOOL* ret);
    STDMETHOD(UpdateToolStatus)(/*[in]*/ IDispatch* ThisTool, /*[in, out]*/ VARIANT_BOOL* Enabled, /*[in, out]*/ VARIANT_BOOL* Checked, /*[out, retval]*/ VARIANT_BOOL* ret);
    STDMETHOD(Run)(/*[in]*/ IDispatch* ThisTool, /*[out, retval]*/ VARIANT_BOOL* ret);
    STDMETHOD(GetPicture)(/*[in]*/ VARIANT_BOOL LargeButtons, /*[in]*/ VARIANT_BOOL Monochrome, /*[out, retval]*/ IDispatch** ret);
    STDMETHOD(CopyBitmap)(/*[in]*/ VARIANT_BOOL LargeButtons, /*[in]*/ VARIANT_BOOL Monochrome, /*[out, retval]*/ VARIANT_BOOL* ret);
    STDMETHOD(GetToolInfo)(/*[in, out]*/ VARIANT* CommandNames, /*[in, out]*/ VARIANT* MenuCaptions, /*[in, out]*/ VARIANT* StatusPrompts, /*[in, out]*/ VARIANT* ToolTips, /*[in, out]*/ VARIANT* Enabled, /*[in, out]*/ VARIANT* WantsUpdates, /*[out, retval]*/ long* ret);
    STDMETHOD(PointSnapped)(/*[in]*/  IDispatch *WhichDrawing, /*[in]*/ IDispatch  *WhichView, /*[in]*/ long X, /*[in]*/ long Y, /*[in]*/ IDispatch *PointRaw, /*[in]*/ IDispatch  *PointSnapped);
    STDMETHOD(DrawingDeactivate)(/* [in]*/ IDispatch *WhichDrawing);
    STDMETHOD(DrawingBeforeClose)( /*[in]*/ LPDISPATCH WhichDrawing, VARIANT_BOOL* Cancel);

};

#endif //__EXSYMBOL_H_


Examples - C++ Insert External Symbol Tool - InsertExternalSymbol.cpp

InsertExternalSymbol.cpp

C++ Insert External Symbol Tool Example

// InsertExternalSymbol.cpp : Implementation of DLL Exports.

// Note: Proxy/Stub Information
//      To build a separate proxy/stub DLL,
//      run nmake -f InsertExternalSymbolps.mk in the project directory.

#include "stdafx.h"
#include "resource.h"
#include <initguid.h>
#include "InsertExternalSymbol.h"

#include "InsertExternalSymbol_i.c"
#include "ExSymbol.h"

CComModule _Module;

COleVariant varMissing((long)DISP_E_PARAMNOTFOUND, VT_ERROR);

BEGIN_OBJECT_MAP(ObjectMap)
OBJECT_ENTRY(CLSID_ExSymbol, CExSymbol)
END_OBJECT_MAP()

class CInsertExternalSymbolApp : public CWinApp
{
public:

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CInsertExternalSymbolApp)
    public:
    virtual BOOL InitInstance();
    virtual int ExitInstance();
    //}}AFX_VIRTUAL

    //{{AFX_MSG(CInsertExternalSymbolApp)
        // NOTE - the ClassWizard will add and remove member functions here.
        //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

BEGIN_MESSAGE_MAP(CInsertExternalSymbolApp, CWinApp)
    //{{AFX_MSG_MAP(CInsertExternalSymbolApp)
        // NOTE - the ClassWizard will add and remove mapping macros here.
        //    DO NOT EDIT what you see in these blocks of generated code!
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

CInsertExternalSymbolApp theApp;

BOOL CInsertExternalSymbolApp::InitInstance()
{
    _Module.Init(ObjectMap, m_hInstance, &LIBID_INSERTEXTERNALSYMBOLLib);
    return CWinApp::InitInstance();
}

int CInsertExternalSymbolApp::ExitInstance()
{
    _Module.Term();
    return CWinApp::ExitInstance();
}

/////////////////////////////////////////////////////////////////////////////
// Used to determine whether the DLL can be unloaded by OLE

STDAPI DllCanUnloadNow(void)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    return (AfxDllCanUnloadNow()==S_OK && _Module.GetLockCount()==0) ? S_OK : S_FALSE;
}

/////////////////////////////////////////////////////////////////////////////
// Returns a class factory to create an object of the requested type

STDAPI DllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID* ppv)
{
    return _Module.GetClassObject(rclsid, riid, ppv);
}

/////////////////////////////////////////////////////////////////////////////
// DllRegisterServer - Adds entries to the system registry

STDAPI DllRegisterServer(void)
{
    // registers object, typelib and all interfaces in typelib
    return _Module.RegisterServer(TRUE);
}

/////////////////////////////////////////////////////////////////////////////
// DllUnregisterServer - Removes entries from the system registry

STDAPI DllUnregisterServer(void)
{
    return _Module.UnregisterServer(TRUE);
}


Examples - C++ Insert External Symbol Tool - InsertExternalSymbol.h

InsertExternalSymbol.h

C++ Insert External Symbol Tool Example

/* this ALWAYS GENERATED file contains the definitions for the interfaces */

/* File created by MIDL compiler version 5.01.0164 */
/* at Wed May 24 13:20:19 2000
 */
/* Compiler settings for E:\tc70\SDK\Tools\InsertExternalSymbol\InsertExternalSymbol.idl:
    Oicf (OptLev=i2), W1, Zp8, env=Win32, ms_ext, c_ext
    error checks: allocation ref bounds_check enum stub_data
*/
//@@MIDL_FILE_HEADING(  )

/* verify that the <rpcndr.h> version is high enough to compile this file*/
#ifndef __REQUIRED_RPCNDR_H_VERSION__
#define __REQUIRED_RPCNDR_H_VERSION__ 440
#endif

#include "rpc.h"
#include "rpcndr.h"

#ifndef __RPCNDR_H_VERSION__
#error this stub requires an updated version of <rpcndr.h>
#endif // __RPCNDR_H_VERSION__

#ifndef COM_NO_WINDOWS_H
#include "windows.h"
#include "ole2.h"
#endif /*COM_NO_WINDOWS_H*/

#ifndef __InsertExternalSymbol_h__
#define __InsertExternalSymbol_h__

#ifdef __cplusplus
extern "C"{
#endif

/* Forward Declarations */

#ifndef __IExSymbol_FWD_DEFINED__
#define __IExSymbol_FWD_DEFINED__
typedef interface IExSymbol IExSymbol;
#endif 	/* __IExSymbol_FWD_DEFINED__ */

#ifndef __ExSymbol_FWD_DEFINED__
#define __ExSymbol_FWD_DEFINED__

#ifdef __cplusplus
typedef class ExSymbol ExSymbol;
#else
typedef struct ExSymbol ExSymbol;
#endif /* __cplusplus */

#endif 	/* __ExSymbol_FWD_DEFINED__ */

/* header files for imported files */
#include "oaidl.h"
#include "ocidl.h"

void __RPC_FAR * __RPC_USER MIDL_user_allocate(size_t);
void __RPC_USER MIDL_user_free( void __RPC_FAR * );

#ifndef __IExSymbol_INTERFACE_DEFINED__
#define __IExSymbol_INTERFACE_DEFINED__

/* interface IExSymbol */
/* [unique][helpstring][dual][uuid][object] */

EXTERN_C const IID IID_IExSymbol;

#if defined(__cplusplus) && !defined(CINTERFACE)

    MIDL_INTERFACE("E322DED1-3438-4DAA-B5B4-8F8C4538D0E9")
    IExSymbol : public IDispatch
    {
    public:
        virtual /* [helpstring][id][propget] */ HRESULT STDMETHODCALLTYPE get_ClassID(
            /* [retval][out] */ BSTR __RPC_FAR *pVal) = 0;

        virtual /* [helpstring][id][propget] */ HRESULT STDMETHODCALLTYPE get_Description(
            /* [retval][out] */ BSTR __RPC_FAR *pVal) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE GetToolInfo(
            /* [out][in] */ VARIANT __RPC_FAR *CommandNames,
            /* [out][in] */ VARIANT __RPC_FAR *MenuCaptions,
            /* [out][in] */ VARIANT __RPC_FAR *StatusPrompts,
            /* [out][in] */ VARIANT __RPC_FAR *ToolTips,
            /* [out][in] */ VARIANT __RPC_FAR *Enabled,
            /* [out][in] */ VARIANT __RPC_FAR *WantsUpdates,
            /* [retval][out] */ long __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE CopyBitmap(
            /* [in] */ VARIANT_BOOL LargeButtons,
            /* [in] */ VARIANT_BOOL Monochrome,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE GetPicture(
            /* [in] */ VARIANT_BOOL LargeButtons,
            /* [in] */ VARIANT_BOOL Monochrome,
            /* [retval][out] */ IDispatch __RPC_FAR *__RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE Run(
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE UpdateToolStatus(
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Enabled,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Checked,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE Initialize(
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE Terminate(
            /* [in] */ IDispatch __RPC_FAR *ThisTool) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE MouseDown(
            /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
            /* [in] */ IDispatch __RPC_FAR *WhichView,
            /* [in] */ IDispatch __RPC_FAR *WhichWindow,
            /* [in] */ short Button,
            /* [in] */ long Shift,
            /* [in] */ long X,
            /* [in] */ long Y,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Cancel) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE BeforeExit(
            /* [in] */ IDispatch __RPC_FAR *TheApp,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Cancel) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE RunTool(
            /* [in] */ IDispatch __RPC_FAR *ThisTool) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE MouseUp(
            LPDISPATCH WhichDrawing,
            LPDISPATCH WhichView,
            LPDISPATCH WhichWindow,
            short Button,
            long Shift,
            long X,
            long Y,
            VARIANT_BOOL __RPC_FAR *pbCancel) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE MouseMove(
            LPDISPATCH WhichDrawing,
            LPDISPATCH WhichView,
            LPDISPATCH WhichWindow,
            long Shift,
            long X,
            long Y,
            VARIANT_BOOL __RPC_FAR *pbCancel) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE SelectionChange(
            /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
            /* [in] */ IDispatch __RPC_FAR *WhichView,
            /* [in] */ IDispatch __RPC_FAR *WhichWindow,
            /* [in] */ IDispatch __RPC_FAR *Sel) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE PointSnapped(
            /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
            /* [in] */ IDispatch __RPC_FAR *WhichView,
            /* [in] */ long X,
            /* [in] */ long Y,
            /* [in] */ IDispatch __RPC_FAR *PointRaw,
            /* [in] */ IDispatch __RPC_FAR *PointSnapped) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE DrawingBeforeClose(
            /* [in] */ LPDISPATCH WhichDrawing,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Cancel) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE DrawingDeactivate(
            /* [in] */ IDispatch __RPC_FAR *WhichDrawing) = 0;

    };

#else 	/* C style interface */

    typedef struct IExSymbolVtbl
    {
        BEGIN_INTERFACE

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *QueryInterface )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [iid_is][out] */ void __RPC_FAR *__RPC_FAR *ppvObject);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *AddRef )(
            IExSymbol __RPC_FAR * This);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *Release )(
            IExSymbol __RPC_FAR * This);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetTypeInfoCount )(
            IExSymbol __RPC_FAR * This,
            /* [out] */ UINT __RPC_FAR *pctinfo);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetTypeInfo )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ UINT iTInfo,
            /* [in] */ LCID lcid,
            /* [out] */ ITypeInfo __RPC_FAR *__RPC_FAR *ppTInfo);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetIDsOfNames )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [size_is][in] */ LPOLESTR __RPC_FAR *rgszNames,
            /* [in] */ UINT cNames,
            /* [in] */ LCID lcid,
            /* [size_is][out] */ DISPID __RPC_FAR *rgDispId);

        /* [local] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Invoke )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ DISPID dispIdMember,
            /* [in] */ REFIID riid,
            /* [in] */ LCID lcid,
            /* [in] */ WORD wFlags,
            /* [out][in] */ DISPPARAMS __RPC_FAR *pDispParams,
            /* [out] */ VARIANT __RPC_FAR *pVarResult,
            /* [out] */ EXCEPINFO __RPC_FAR *pExcepInfo,
            /* [out] */ UINT __RPC_FAR *puArgErr);

        /* [helpstring][id][propget] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *get_ClassID )(
            IExSymbol __RPC_FAR * This,
            /* [retval][out] */ BSTR __RPC_FAR *pVal);

        /* [helpstring][id][propget] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *get_Description )(
            IExSymbol __RPC_FAR * This,
            /* [retval][out] */ BSTR __RPC_FAR *pVal);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetToolInfo )(
            IExSymbol __RPC_FAR * This,
            /* [out][in] */ VARIANT __RPC_FAR *CommandNames,
            /* [out][in] */ VARIANT __RPC_FAR *MenuCaptions,
            /* [out][in] */ VARIANT __RPC_FAR *StatusPrompts,
            /* [out][in] */ VARIANT __RPC_FAR *ToolTips,
            /* [out][in] */ VARIANT __RPC_FAR *Enabled,
            /* [out][in] */ VARIANT __RPC_FAR *WantsUpdates,
            /* [retval][out] */ long __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *CopyBitmap )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ VARIANT_BOOL LargeButtons,
            /* [in] */ VARIANT_BOOL Monochrome,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetPicture )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ VARIANT_BOOL LargeButtons,
            /* [in] */ VARIANT_BOOL Monochrome,
            /* [retval][out] */ IDispatch __RPC_FAR *__RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Run )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *UpdateToolStatus )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Enabled,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Checked,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Initialize )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Terminate )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *ThisTool);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *MouseDown )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
            /* [in] */ IDispatch __RPC_FAR *WhichView,
            /* [in] */ IDispatch __RPC_FAR *WhichWindow,
            /* [in] */ short Button,
            /* [in] */ long Shift,
            /* [in] */ long X,
            /* [in] */ long Y,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Cancel);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *BeforeExit )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *TheApp,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Cancel);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *RunTool )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *ThisTool);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *MouseUp )(
            IExSymbol __RPC_FAR * This,
            LPDISPATCH WhichDrawing,
            LPDISPATCH WhichView,
            LPDISPATCH WhichWindow,
            short Button,
            long Shift,
            long X,
            long Y,
            VARIANT_BOOL __RPC_FAR *pbCancel);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *MouseMove )(
            IExSymbol __RPC_FAR * This,
            LPDISPATCH WhichDrawing,
            LPDISPATCH WhichView,
            LPDISPATCH WhichWindow,
            long Shift,
            long X,
            long Y,
            VARIANT_BOOL __RPC_FAR *pbCancel);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *SelectionChange )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
            /* [in] */ IDispatch __RPC_FAR *WhichView,
            /* [in] */ IDispatch __RPC_FAR *WhichWindow,
            /* [in] */ IDispatch __RPC_FAR *Sel);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *PointSnapped )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
            /* [in] */ IDispatch __RPC_FAR *WhichView,
            /* [in] */ long X,
            /* [in] */ long Y,
            /* [in] */ IDispatch __RPC_FAR *PointRaw,
            /* [in] */ IDispatch __RPC_FAR *PointSnapped);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *DrawingBeforeClose )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ LPDISPATCH WhichDrawing,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Cancel);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *DrawingDeactivate )(
            IExSymbol __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *WhichDrawing);

        END_INTERFACE
    } IExSymbolVtbl;

    interface IExSymbol
    {
        CONST_VTBL struct IExSymbolVtbl __RPC_FAR *lpVtbl;
    };

#ifdef COBJMACROS

#define IExSymbol_QueryInterface(This,riid,ppvObject)	\
    (This)->lpVtbl -> QueryInterface(This,riid,ppvObject)

#define IExSymbol_AddRef(This)	\
    (This)->lpVtbl -> AddRef(This)

#define IExSymbol_Release(This)	\
    (This)->lpVtbl -> Release(This)

#define IExSymbol_GetTypeInfoCount(This,pctinfo)	\
    (This)->lpVtbl -> GetTypeInfoCount(This,pctinfo)

#define IExSymbol_GetTypeInfo(This,iTInfo,lcid,ppTInfo)	\
    (This)->lpVtbl -> GetTypeInfo(This,iTInfo,lcid,ppTInfo)

#define IExSymbol_GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)	\
    (This)->lpVtbl -> GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)

#define IExSymbol_Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)	\
    (This)->lpVtbl -> Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)

#define IExSymbol_get_ClassID(This,pVal)	\
    (This)->lpVtbl -> get_ClassID(This,pVal)

#define IExSymbol_get_Description(This,pVal)	\
    (This)->lpVtbl -> get_Description(This,pVal)

#define IExSymbol_GetToolInfo(This,CommandNames,MenuCaptions,StatusPrompts,ToolTips,Enabled,WantsUpdates,ret)	\
    (This)->lpVtbl -> GetToolInfo(This,CommandNames,MenuCaptions,StatusPrompts,ToolTips,Enabled,WantsUpdates,ret)

#define IExSymbol_CopyBitmap(This,LargeButtons,Monochrome,ret)	\
    (This)->lpVtbl -> CopyBitmap(This,LargeButtons,Monochrome,ret)

#define IExSymbol_GetPicture(This,LargeButtons,Monochrome,ret)	\
    (This)->lpVtbl -> GetPicture(This,LargeButtons,Monochrome,ret)

#define IExSymbol_Run(This,ThisTool,ret)	\
    (This)->lpVtbl -> Run(This,ThisTool,ret)

#define IExSymbol_UpdateToolStatus(This,ThisTool,Enabled,Checked,ret)	\
    (This)->lpVtbl -> UpdateToolStatus(This,ThisTool,Enabled,Checked,ret)

#define IExSymbol_Initialize(This,ThisTool,ret)	\
    (This)->lpVtbl -> Initialize(This,ThisTool,ret)

#define IExSymbol_Terminate(This,ThisTool)	\
    (This)->lpVtbl -> Terminate(This,ThisTool)

#define IExSymbol_MouseDown(This,WhichDrawing,WhichView,WhichWindow,Button,Shift,X,Y,Cancel)	\
    (This)->lpVtbl -> MouseDown(This,WhichDrawing,WhichView,WhichWindow,Button,Shift,X,Y,Cancel)

#define IExSymbol_BeforeExit(This,TheApp,Cancel)	\
    (This)->lpVtbl -> BeforeExit(This,TheApp,Cancel)

#define IExSymbol_RunTool(This,ThisTool)	\
    (This)->lpVtbl -> RunTool(This,ThisTool)

#define IExSymbol_MouseUp(This,WhichDrawing,WhichView,WhichWindow,Button,Shift,X,Y,pbCancel)	\
    (This)->lpVtbl -> MouseUp(This,WhichDrawing,WhichView,WhichWindow,Button,Shift,X,Y,pbCancel)

#define IExSymbol_MouseMove(This,WhichDrawing,WhichView,WhichWindow,Shift,X,Y,pbCancel)	\
    (This)->lpVtbl -> MouseMove(This,WhichDrawing,WhichView,WhichWindow,Shift,X,Y,pbCancel)

#define IExSymbol_SelectionChange(This,WhichDrawing,WhichView,WhichWindow,Sel)	\
    (This)->lpVtbl -> SelectionChange(This,WhichDrawing,WhichView,WhichWindow,Sel)

#define IExSymbol_PointSnapped(This,WhichDrawing,WhichView,X,Y,PointRaw,PointSnapped)	\
    (This)->lpVtbl -> PointSnapped(This,WhichDrawing,WhichView,X,Y,PointRaw,PointSnapped)

#define IExSymbol_DrawingBeforeClose(This,WhichDrawing,Cancel)	\
    (This)->lpVtbl -> DrawingBeforeClose(This,WhichDrawing,Cancel)

#define IExSymbol_DrawingDeactivate(This,WhichDrawing)	\
    (This)->lpVtbl -> DrawingDeactivate(This,WhichDrawing)

#endif /* COBJMACROS */

#endif 	/* C style interface */

/* [helpstring][id][propget] */ HRESULT STDMETHODCALLTYPE IExSymbol_get_ClassID_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [retval][out] */ BSTR __RPC_FAR *pVal);

void __RPC_STUB IExSymbol_get_ClassID_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id][propget] */ HRESULT STDMETHODCALLTYPE IExSymbol_get_Description_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [retval][out] */ BSTR __RPC_FAR *pVal);

void __RPC_STUB IExSymbol_get_Description_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_GetToolInfo_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [out][in] */ VARIANT __RPC_FAR *CommandNames,
    /* [out][in] */ VARIANT __RPC_FAR *MenuCaptions,
    /* [out][in] */ VARIANT __RPC_FAR *StatusPrompts,
    /* [out][in] */ VARIANT __RPC_FAR *ToolTips,
    /* [out][in] */ VARIANT __RPC_FAR *Enabled,
    /* [out][in] */ VARIANT __RPC_FAR *WantsUpdates,
    /* [retval][out] */ long __RPC_FAR *ret);

void __RPC_STUB IExSymbol_GetToolInfo_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_CopyBitmap_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [in] */ VARIANT_BOOL LargeButtons,
    /* [in] */ VARIANT_BOOL Monochrome,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IExSymbol_CopyBitmap_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_GetPicture_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [in] */ VARIANT_BOOL LargeButtons,
    /* [in] */ VARIANT_BOOL Monochrome,
    /* [retval][out] */ IDispatch __RPC_FAR *__RPC_FAR *ret);

void __RPC_STUB IExSymbol_GetPicture_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_Run_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *ThisTool,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IExSymbol_Run_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_UpdateToolStatus_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *ThisTool,
    /* [out][in] */ VARIANT_BOOL __RPC_FAR *Enabled,
    /* [out][in] */ VARIANT_BOOL __RPC_FAR *Checked,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IExSymbol_UpdateToolStatus_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_Initialize_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *ThisTool,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IExSymbol_Initialize_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_Terminate_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *ThisTool);

void __RPC_STUB IExSymbol_Terminate_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_MouseDown_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
    /* [in] */ IDispatch __RPC_FAR *WhichView,
    /* [in] */ IDispatch __RPC_FAR *WhichWindow,
    /* [in] */ short Button,
    /* [in] */ long Shift,
    /* [in] */ long X,
    /* [in] */ long Y,
    /* [out][in] */ VARIANT_BOOL __RPC_FAR *Cancel);

void __RPC_STUB IExSymbol_MouseDown_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_BeforeExit_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *TheApp,
    /* [out][in] */ VARIANT_BOOL __RPC_FAR *Cancel);

void __RPC_STUB IExSymbol_BeforeExit_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_RunTool_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *ThisTool);

void __RPC_STUB IExSymbol_RunTool_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_MouseUp_Proxy(
    IExSymbol __RPC_FAR * This,
    LPDISPATCH WhichDrawing,
    LPDISPATCH WhichView,
    LPDISPATCH WhichWindow,
    short Button,
    long Shift,
    long X,
    long Y,
    VARIANT_BOOL __RPC_FAR *pbCancel);

void __RPC_STUB IExSymbol_MouseUp_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_MouseMove_Proxy(
    IExSymbol __RPC_FAR * This,
    LPDISPATCH WhichDrawing,
    LPDISPATCH WhichView,
    LPDISPATCH WhichWindow,
    long Shift,
    long X,
    long Y,
    VARIANT_BOOL __RPC_FAR *pbCancel);

void __RPC_STUB IExSymbol_MouseMove_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_SelectionChange_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
    /* [in] */ IDispatch __RPC_FAR *WhichView,
    /* [in] */ IDispatch __RPC_FAR *WhichWindow,
    /* [in] */ IDispatch __RPC_FAR *Sel);

void __RPC_STUB IExSymbol_SelectionChange_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_PointSnapped_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
    /* [in] */ IDispatch __RPC_FAR *WhichView,
    /* [in] */ long X,
    /* [in] */ long Y,
    /* [in] */ IDispatch __RPC_FAR *PointRaw,
    /* [in] */ IDispatch __RPC_FAR *PointSnapped);

void __RPC_STUB IExSymbol_PointSnapped_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_DrawingBeforeClose_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [in] */ LPDISPATCH WhichDrawing,
    /* [out][in] */ VARIANT_BOOL __RPC_FAR *Cancel);

void __RPC_STUB IExSymbol_DrawingBeforeClose_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IExSymbol_DrawingDeactivate_Proxy(
    IExSymbol __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *WhichDrawing);

void __RPC_STUB IExSymbol_DrawingDeactivate_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

#endif 	/* __IExSymbol_INTERFACE_DEFINED__ */

#ifndef __INSERTEXTERNALSYMBOLLib_LIBRARY_DEFINED__
#define __INSERTEXTERNALSYMBOLLib_LIBRARY_DEFINED__

/* library INSERTEXTERNALSYMBOLLib */
/* [helpstring][version][uuid] */

EXTERN_C const IID LIBID_INSERTEXTERNALSYMBOLLib;

EXTERN_C const CLSID CLSID_ExSymbol;

#ifdef __cplusplus

class DECLSPEC_UUID("71CA2F31-B56D-4CAC-BA97-EDB14712A14A")
ExSymbol;
#endif
#endif /* __INSERTEXTERNALSYMBOLLib_LIBRARY_DEFINED__ */

/* Additional Prototypes for ALL interfaces */

unsigned long             __RPC_USER  BSTR_UserSize(     unsigned long __RPC_FAR *, unsigned long            , BSTR __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  BSTR_UserMarshal(  unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, BSTR __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  BSTR_UserUnmarshal(unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, BSTR __RPC_FAR * );
void                      __RPC_USER  BSTR_UserFree(     unsigned long __RPC_FAR *, BSTR __RPC_FAR * );

unsigned long             __RPC_USER  VARIANT_UserSize(     unsigned long __RPC_FAR *, unsigned long            , VARIANT __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  VARIANT_UserMarshal(  unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, VARIANT __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  VARIANT_UserUnmarshal(unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, VARIANT __RPC_FAR * );
void                      __RPC_USER  VARIANT_UserFree(     unsigned long __RPC_FAR *, VARIANT __RPC_FAR * );

/* end of Additional Prototypes */

#ifdef __cplusplus
}
#endif

#endif


Examples - C++ Insert Regen Object Tool - events.h

events.h

C++ Insert Regen Object Tool Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1996                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/

// Events.h : main header file for the EVENTS application
//

#ifndef __AFXWIN_H__
    #error include 'stdafx.h' before including this file for PCH
#endif

#include "resource.h"		// main symbols

//class CTCEventsDlg;
class CSdiDialog;
/////////////////////////////////////////////////////////////////////////////
// CTCEventsApp:
// See Events.cpp for the implementation of this class
//

class CTCEventsApp : public CWinApp
{
public:
    CTCEventsApp();

    CSdiDialog* GetDialog() const { return (CSdiDialog*)m_pMainWnd; }

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CTCEventsApp)
    public:
    virtual BOOL InitInstance();
    //}}AFX_VIRTUAL

// Implementation
    //{{AFX_MSG(CTCEventsApp)
        // NOTE - the ClassWizard will add and remove member functions here.
        //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()

    // Generated OLE dispatch map functions
    //{{AFX_DISPATCH(CTCEventsApp)
    afx_msg void BeforeExit(LPDISPATCH TheApp, BOOL FAR* Cancel);
    afx_msg void DrawingNew(LPDISPATCH WhichDrawing);
    afx_msg void DrawingOpen(LPDISPATCH WhichDrawing);
    afx_msg void DrawingActivate(LPDISPATCH WhichDrawing);
    afx_msg void DrawingDeactivate(LPDISPATCH WhichDrawing);
    afx_msg void DrawingBeforeClose(LPDISPATCH WhichDrawing, BOOL FAR* Cancel);
    afx_msg void DrawingBeforeSave(LPDISPATCH WhichDrawing, BOOL FAR* SaveAs, BOOL FAR* Cancel);
    afx_msg void WindowResize(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow);
    afx_msg void WindowActivate(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow);
    afx_msg void WindowDeactivate(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow);
    afx_msg void MouseDown(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y);
    afx_msg void MouseUp(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y);
    afx_msg void MouseMove(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, long Shift, long X, long Y);
    afx_msg void BeforeDoubleClick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel, BOOL FAR* Cancel);
    afx_msg void BeforeRightClick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel, BOOL FAR* Cancel);
    afx_msg void SelectionChange(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel);
    afx_msg void CommandBarControlHit(LPDISPATCH WhichControl, BOOL FAR* Cancel);
    afx_msg void CommandBarControlStatus(LPDISPATCH WhichControl);
    afx_msg void RunTool(LPDISPATCH WhichTool);
    afx_msg void PointSnapped(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, long XScreen, long YScreen, LPDISPATCH PointRaw, LPDISPATCH PointSnapped);
    afx_msg void PointPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled);
    afx_msg void RectanglePick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled);
    afx_msg void PolygonPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled);
    afx_msg void ViewBeforeRedraw(LPDISPATCH WhichDrawing, LPDISPATCH WhichView);
    afx_msg void ViewAfterRedraw(LPDISPATCH WhichDrawing, LPDISPATCH WhichView);
    afx_msg void VirtualIntersectionPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH PickResult, BOOL WasCanceled);
    afx_msg void CommandBarControlDone(LPDISPATCH WhichControl);
    afx_msg void Drop(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Selection);
    //}}AFX_DISPATCH
    DECLARE_DISPATCH_MAP()
    DECLARE_INTERFACE_MAP()

    // DUAL_SUPPORT_START
    //    add declaration of AppEvents implementation
    //	  You need one entry here for each entry in the
    //	  interface statement of the ODL, plus the entries for a
    //	  dispatch interface. The BEGIN_DUAL_INTERFACE_PART
    //	  macro in mfcdual.h automatically generates the IDispatch
    //	  entries for you.
    //	  Each entry with the "propput" attribute needs a function
    //    named "put_<property name>". Each entry with the "propget"
    //	  attribute needs a function named "get_<property name>".
    //	  You can pull these function prototypes from the header file
    //	  generated by MKTYPLIB.
    BEGIN_DUAL_INTERFACE_PART(AppEvents, IAppEvents)
    STDMETHOD(BeforeExit)(THIS_ IApplication* TheApp, IMSI_BOOL* Cancel);
    STDMETHOD(DrawingNew)(THIS_ IDrawing* WhichDrawing);
    STDMETHOD(DrawingOpen)(THIS_ IDrawing* WhichDrawing);
    STDMETHOD(DrawingActivate)(THIS_ IDrawing* WhichDrawing);
    STDMETHOD(DrawingDeactivate)(THIS_ IDrawing* WhichDrawing);
    STDMETHOD(DrawingBeforeClose)(THIS_ IDrawing* WhichDrawing, IMSI_BOOL* Cancel);
    STDMETHOD(DrawingBeforeSave)(THIS_ IDrawing* WhichDrawing, IMSI_BOOL* SaveAs, IMSI_BOOL* Cancel);
    STDMETHOD(WindowResize)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow);
    STDMETHOD(WindowActivate)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow);
    STDMETHOD(WindowDeactivate)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow);
    STDMETHOD(MouseDown)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, ImsiMouseButton Button, long Shift, long X, long Y);
    STDMETHOD(MouseUp)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, ImsiMouseButton Button, long Shift, long X, long Y);
    STDMETHOD(MouseMove)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, long Shift, long X, long Y);
    STDMETHOD(BeforeDoubleClick)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, Selection* Sel, IMSI_BOOL* Cancel);
    STDMETHOD(BeforeRightClick)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, Selection* Sel, IMSI_BOOL* Cancel);
    STDMETHOD(SelectionChange)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, Selection* Sel);
    STDMETHOD(CommandBarControlHit)(THIS_ CommandBarControl* WhichControl, IMSI_BOOL* Cancel);
    STDMETHOD(CommandBarControlStatus)(THIS_ CommandBarControl* WhichControl);
    STDMETHOD(RunTool)(THIS_ Tool* WhichTool);
    STDMETHOD(PointSnapped)(THIS_ IDrawing* WhichDrawing, View* WhichView, long XScreen, long YScreen, IVertex* PointRaw, IVertex* PointSnapped);
    STDMETHOD(PointPick)(THIS_ IDrawing* WhichDrawing, View* WhichView, PickResult* Pick, IMSI_BOOL WasCanceled);
    STDMETHOD(RectanglePick)(THIS_ IDrawing* WhichDrawing, View* WhichView, PickResult* Pick, IMSI_BOOL WasCanceled);
    STDMETHOD(PolygonPick)(THIS_ IDrawing* WhichDrawing, View* WhichView, PickResult* Pick, IMSI_BOOL WasCanceled);
    STDMETHOD(ViewBeforeRedraw)(THIS_ IDrawing* WhichDrawing, View* WhichView);
    STDMETHOD(ViewAfterRedraw)(THIS_ IDrawing* WhichDrawing, View* WhichView);
    STDMETHOD(VirtualIntersectionPick)(THIS_ IDrawing* WhichDrawing, View* WhichView, PickResult* Pick, IMSI_BOOL WasCanceled);
    STDMETHOD(CommandBarControlDone)(THIS_ CommandBarControl* WhichControl);
    STDMETHOD(Drop)(THIS_ IDrawing* WhichDrawing, View* WhichView, Window* WhichWindow, Selection* Sel);
    END_DUAL_INTERFACE_PART(AppEvents)

    //     add declaration of ISupportErrorInfo implementation
    //     to indicate we support the OLE Automation error object
    DECLARE_DUAL_ERRORINFO()
    // DUAL_SUPPORT_END
};

/////////////////////////////////////////////////////////////////////////////


Examples - C++ Insert Regen Object Tool - InsSmObj.cpp

InsSmObj.cpp

C++ Insert Regen Object Tool Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/

// Note: Proxy/Stub Information
//		To build a separate proxy/stub DLL,
//		run nmake -f AALBToolps.mk in the project directory.

#include "stdafx.h"
#include "resource.h"
//#include "initguid.h"
#include "InsSmObj.h"

#include "InsSmObj_i.c"
#include "SmObj.h"

COleVariant varMissing((long)DISP_E_PARAMNOTFOUND, VT_ERROR);
COleVariant varTrue(1L);
COleVariant varFalse(0L);

CComModule _Module;

BEGIN_OBJECT_MAP(ObjectMap)
    OBJECT_ENTRY(CLSID_InsSmObj, CInsSmObj)
END_OBJECT_MAP()

CInsSmObjApp theApp;

BOOL CInsSmObjApp::InitInstance()
{
    _Module.Init(ObjectMap, m_hInstance);
    return CWinApp::InitInstance();
}

int CInsSmObjApp::ExitInstance()
{
    _Module.Term();
    return CWinApp::ExitInstance();
}

/////////////////////////////////////////////////////////////////////////////
// Used to determine whether the DLL can be unloaded by OLE

STDAPI DllCanUnloadNow(void)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    return (AfxDllCanUnloadNow()==S_OK && _Module.GetLockCount()==0) ? S_OK : S_FALSE;
}

/////////////////////////////////////////////////////////////////////////////
// Returns a class factory to create an object of the requested type

STDAPI DllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID* ppv)
{
    return _Module.GetClassObject(rclsid, riid, ppv);
}

/////////////////////////////////////////////////////////////////////////////
// DllRegisterServer - Adds entries to the system registry

STDAPI DllRegisterServer(void)
{
    // registers object, typelib and all interfaces in typelib
    return _Module.RegisterServer(TRUE);
}

/////////////////////////////////////////////////////////////////////////////
// DllUnregisterServer - Removes entries from the system registry

STDAPI DllUnregisterServer(void)
{
    _Module.UnregisterServer();
    return S_OK;
}


Examples - C++ Insert Regen Object Tool - SdiDialog.cpp

SdiDialog.cpp

C++ Insert Regen Object Tool Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// SdiDialog.cpp : implementation file
//

#include "stdafx.h"
#include "InsSmObj.h"
#include "SdiDialog.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

//extern CSdiDialog CSDlg;

const	HRESULT hRes = S_OK;
const IID LIBID_IMSIGXLib = {0x6A481400,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_PickResult = {0x6A481123,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
//const IID IID_Tool = {0x6A48112C,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_Graphics = {0x6A48110A, 0xE531, 0x11CF, {0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_View = {0x6A481110, 0xE531, 0x11CF, {0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_Window = {0x6A481124, 0xE531, 0x11CF, {0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF} };
const CLSID CLSID_Application  = {0x6A481001,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const CLSID CLSID_XGraphic  = {0x6A481803,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

//const CLSID CLSID_XApplication = {0x6A481801,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
//const IID IID_IApplication = {0x6A481101,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
static const IID IID_IAppEvents =
{ 0x6A481301, 0xE531, 0x11CF, { 0xA1, 0x15, 0x0, 0xA0, 0x24, 0x15, 0x8D, 0xAF } };

/////////////////////////////////////////////////////////////////////////////
// CSdiDialog dialog

    long a = 0;

BEGIN_MESSAGE_MAP(CSdiDialog, CDialog)
    //{{AFX_MSG_MAP(CSdiDialog)
    ON_BN_CLICKED(ID_CLOSE, OnClose)
    ON_BN_CLICKED(IDC_PROPERTIES, OnProperties)
    ON_WM_DESTROY()
    ON_WM_SYSCOMMAND()
    //}}AFX_MSG_MAP
///	ON_LBN_DBLCLK(IDC_LIST1, onDoubleClick)
END_MESSAGE_MAP()

BEGIN_DISPATCH_MAP(CSdiDialog, CDialog)
    //{{AFX_DISPATCH_MAP(CTCEventsApp)
    DISP_FUNCTION(CSdiDialog, "MouseDown", MouseDown, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_I2 VTS_I4 VTS_I4 VTS_I4 VTS_PBOOL)
    DISP_FUNCTION(CSdiDialog, "MouseUp", MouseUp, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_I2 VTS_I4 VTS_I4 VTS_I4 VTS_PBOOL)
    DISP_FUNCTION(CSdiDialog, "MouseMove", MouseMove, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_I4 VTS_I4 VTS_I4 VTS_PBOOL)
//	DISP_FUNCTION(CSdiDialog, "Drop", Drop, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH)
    DISP_FUNCTION(CSdiDialog,	"DrawingBeforeClose", DrawingBeforeClose, VT_EMPTY, VTS_DISPATCH VTS_PBOOL)

    //}}AFX_DISPATCH_MAP
END_DISPATCH_MAP()

BEGIN_INTERFACE_MAP(CSdiDialog, CDialog)
    INTERFACE_PART(CSdiDialog, IID_IAppEvents, Dispatch)
END_INTERFACE_MAP()

void CSdiDialog::MouseDown(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel)
{
    *pbCancel = FALSE;

}

void CSdiDialog::MouseUp(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel)
{

    COleVariant varItem = (0L);
    COleVariant varOptional(varMissing);

    IDrawing *pIDwgTrg = NULL; /// current drawing
    pIDwgTrg = (IDrawing*) WhichDrawing;
    pIDwgTrg->AddRef();
    Graphics *pGrs = NULL;

    *pbCancel = FALSE;
    CPoint point;
    point.x = X;
    point.y = Y;

    try
    {
        if(m_pDragGraphic != 0)
        {

            hRes = pIDwgTrg->get_Graphics(&pGrs); // get current graphic collection
            CHECK_HRESULT(hRes)

            CViewWnd *pPreview = (CViewWnd *) (GetDlgItem(IDC_PREVIEW));

            hRes = pGrs->AddGraphic(m_pDragGraphic, varOptional, varOptional);
            CHECK_HRESULT(hRes)

            hRes = m_pDragGraphic->Update();
            CHECK_HRESULT(hRes)

            if(m_pView != NULL)
            {
                m_pView->Release();
            }

            m_pView = (View*) WhichView;
            m_pView->AddRef();

            EndDrag(point);

            hRes = m_pView->Refresh();
            CHECK_HRESULT(hRes)

            m_FirstClick = FALSE;
        }
    }
    catch (...)
    {
        TRACE_EXCEPTION("CSdiDialog::MouseUp")
    }

    if(m_pDragGraphic != NULL)
    {
        m_pDragGraphic->Release();
        m_pDragGraphic = NULL;
    }
    if (m_pView != NULL)
    {
        m_pView->Release();
        m_pView = NULL;
    }

    if (pGrs != NULL)
    {
        pGrs->Release();
        pGrs = NULL;
    }

    if(pIDwgTrg != NULL)
    {
        pIDwgTrg->Release();
        pIDwgTrg = NULL;
    }

}

void CSdiDialog::MouseMove(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, long Shift, long X, long Y, IMSI_BOOL* pbCancel)
{
//	long i;
    CPoint point;
    point.x = X;
    point.y = Y;

    *pbCancel = FALSE;

    View *pViewCur = NULL;
    COleVariant varItem = (1L);

    try
    {

        if (m_FirstClick == TRUE)
        {

            HCURSOR hOC = ::SetCursor(::LoadCursor(NULL,IDC_WAIT));

            if(m_pView != NULL)
            {
                //m_pView->Release();
                RELEASE(m_pView);
            }
            m_pView = (View *)WhichView;
            m_pView->AddRef();

            CViewWnd *pPreview = (CViewWnd *) (GetDlgItem(IDC_PREVIEW));

            hRes = pPreview->m_pPreviewGraphic->Duplicate(&m_pDragGraphic);
            CHECK_HRESULT(hRes)
            m_pDragGraphic->Release();
            m_pDragGraphic = NULL;

            hRes = pPreview->m_pPreviewGrs->Remove(&varItem, &m_pDragGraphic);
            CHECK_HRESULT(hRes)

            hRes = m_pDragGraphic->put_ID(0);
            CHECK_HRESULT(hRes)

            m_FirstClick = FALSE;
            ::SetCursor(hOC);

            BeginDrag(point);
        }

        else
        {
            if (m_pDragGraphic != NULL && !m_bDragging)/// aalb && (nFlags & MK_LBUTTON))
            {
                if (!BeginDrag(point))
                {
                    m_pDragGraphic->Release();
                    m_pDragGraphic = NULL;
                }
            }
            else if (m_bDragging)
            {

                pViewCur = (View *)WhichView;
                pViewCur->AddRef();
                if (pViewCur != m_pView) // if view is changed then restart drag
                {
                    if(m_pView != NULL)
                    {
                        RELEASE(m_pView);
                    }

                    m_pView = (View *)WhichView;//pViewCur;
                    m_pView->AddRef();
                    pViewCur->Release();
                    pViewCur = NULL;

                    RestartDrag(point);

                }
                Drag(point);
            }

        }
    }
    catch (...)
    {
        TRACE_EXCEPTION("CSdiDialog::OnMouseMove")
    }

}

// Get the running instance of the TurboCAD local server object from the ROT.

void CSdiDialog::DisconnectEvents()
{
    //HRESULT hRes = S_OK;

    if (m_pIApplication == NULL || m_dwEventConnection == 0)
        return;
    try
    {

        HRESULT	hRes = m_pIApplication->DisconnectEvents(m_dwEventConnection);
        CHECK_HRESULT(hRes)
        if (FAILED(hRes))
        {

            //AfxMessageBox("Connection not broken.");//# Localizable string#
            AfxMessageBox(IDS_STRING106);
            return;

        }
        m_dwEventConnection = 0;

    }

    catch (...)
    {
        TRACE_EXCEPTION("CSdiDialog::DisconnectEvents")
    }
    if(m_pIApplication != NULL)
    {
        m_pIApplication->Release();
        m_pIApplication = NULL;
    }

}

//------------------------

CSdiDialog::CSdiDialog(CInsSmObj* pTool, CWnd* pParent, /*=NULL*/RegenMethods *pRgs)
    : CDialog(CSdiDialog::IDD, pParent),
    m_dwEventConnection(0),
    m_dwEventMask(~0UL),
    m_pIApplication(NULL),
    m_ptMouseDown(CPoint(0, 0)),
    m_FirstClick(FALSE),
    m_bDragging(FALSE),
    m_pView(NULL),
    m_pDragGraphic(NULL)

{

    //{{AFX_DATA_INIT(CSdiDialog)
    m_listbox = _T("");
    //}}AFX_DATA_INIT
    m_pTool = pTool;
    m_pTool->AddRef();
    m_pTool->m_bRunned = TRUE;
    m_pRegMets = pRgs;
    ADDREF(m_pRegMets);
}

void CSdiDialog::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CSdiDialog)
    DDX_LBString(pDX, IDC_LIST1, m_listbox);
    //}}AFX_DATA_MAP
}

/////////////////////////////////////////////////////////////////////////////
// CSdiDialog message handlers

BOOL CSdiDialog::OnInitDialog()
{
    CDialog::OnInitDialog();

    m_list.SubclassDlgItem( IDC_LIST1 , this );
    CToolList *pList = (CToolList *)GetDlgItem(IDC_LIST1);

    m_wndView.SubclassDlgItem(IDC_PREVIEW, this);
    CViewWnd *pView = (CViewWnd *)GetDlgItem(IDC_PREVIEW);

    COleVariant varItem;
    CString cstrDesc;
    CString cstrName;

    HRESULT hRes = S_OK;
    RegenMethod *pRegMet = NULL;
    BSTR bstrDescription = NULL;
    BSTR bstrName = NULL;
    ImsiRegenMethodType regenType;
    EnableAutomation();

    long NumRegs = 0;

    try
    {
        hRes = m_pRegMets->get_Count(&NumRegs);
        CHECK_HRESULT(hRes)

        for(long i = 0;i < NumRegs; i++)
        {
            varItem = i;

            hRes = m_pRegMets->get_Item(&varItem,&pRegMet);
            CHECK_HRESULT(hRes)

            hRes = pRegMet->get_Type(&regenType);
            CHECK_HRESULT(hRes)

//			hRes = pRegMet->get_Description(&bstrDescription);

//			if (SUCCEEDED(hRes))
            if(regenType == imsiAutomation)
            {
                    hRes = pRegMet->get_Description(&bstrDescription);
                    if (SUCCEEDED(hRes))
                    {
                        cstrDesc = bstrDescription;
                        ::SysFreeString(bstrDescription);
                        bstrDescription = NULL;

//						if(cstrDesc != "HatchWizard.HatchWizard.1" || cstrDesc != "Smart.Connection.1")
//						if(cstrDesc != "HatchWizard.HatchWizard.1" || cstrDesc != "Smart.Connection.1" )
//						{
                            hRes = pRegMet->get_Name(&bstrName);
                            CHECK_HRESULT(hRes)

                            cstrName = bstrName;
                            ::SysFreeString(bstrName);
                            bstrName = NULL;
                            if(cstrName == "Foundation.House" || cstrName == "AutoDim.House" || cstrName == "Schedule.Block")
                            {
                            }
                            else
                            {
                                pList->AddString(cstrName);
                            }

//						}
                    }
            }

        }
        if(pList->SetCurSel(0) != LB_ERR)
        {

            pList->GetText(0 ,(pList->m_cstrCurSelected));

            pView->CreatePreview();
            pView->DoPreview();
            ConnectEvents();

        }

    }
    catch (...)
    {
        TRACE_EXCEPTION("CSdiDialog::OnInitDialog")
    }

    if (pRegMet != NULL)
    {
        pRegMet->Release();
        pRegMet = NULL;
    }

    if (bstrDescription != NULL)
        ::SysFreeString(bstrDescription);

    if (bstrName != NULL)
        ::SysFreeString(bstrName);

    return TRUE;  // return TRUE unless you set the focus to a control
                  // EXCEPTION: OCX Property Pages should return FALSE
}

void CSdiDialog::PostNcDestroy()
{
    CDialog::PostNcDestroy();
    RELEASE(m_pRegMets)
    delete this;
}

void CSdiDialog::OnClose()
{
    // TODO: Add your message handler code here and/or call default

    if(m_dwEventConnection != 0)
        DisconnectEvents();
    m_pTool->m_bRunned = FALSE;
        if(m_pTool != NULL)
        {
            m_pTool->Release ();
            m_pTool = NULL;
        }

        if(m_pRegMets != NULL)
        {
            m_pRegMets->Release();
            m_pRegMets = NULL;
        }

    CViewWnd *pView = (CViewWnd *)GetDlgItem(IDC_PREVIEW);
    pView->ClearAll();

    CDialog::OnClose();
    DestroyWindow();

}

void CSdiDialog::ConnectEvents()
{
    HRESULT hRes = S_OK;

    if (m_dwEventConnection != 0)
    {
        //AfxMessageBox("Already connected.");//# Localizable string#
        AfxMessageBox(IDS_STRING107);
        return;
    }

    m_pIApplication = NULL;
    try
    {
        hRes = m_pRegMets->get_Application(&m_pIApplication);
        CHECK_HRESULT(hRes)

        if (m_pIApplication == NULL)
        {
                //AfxMessageBox("Can't get a TurboCAD application!");//# Localizable string#
                AfxMessageBox(IDS_STRING108);
                return;
        }

        IDispatch* pUnkEventSink = GetIDispatch(TRUE);

        UpdateData(TRUE);
        COleVariant var((long)m_dwEventMask);
        hRes = m_pIApplication->ConnectEvents(pUnkEventSink,
            &var,
            (long*)&m_dwEventConnection);
        CHECK_HRESULT(hRes)
        if (FAILED(hRes))
        {
            //AfxMessageBox("Connection not established.");//# Localizable string#
            AfxMessageBox(IDS_STRING109);
            return;
        }
    }
    catch (...)
    {
        TRACE_EXCEPTION("CSdiDialog::ConnectEvents")
    }

}

void CSdiDialog::OnProperties()
{
    // TODO: Add your control notification handler code here

    VARIANT varIndex;
    varIndex.vt = VT_I4;
    varIndex.lVal = 0;
    Graphics* pGrs = NULL;

    CViewWnd *pView = (CViewWnd *) (GetDlgItem(IDC_PREVIEW));

    RegenMethod * pCurRegenMethod = NULL;

    short i = 0;
    try
    {
        hRes = pView->m_pPreviewGraphic->get_Graphics(&pGrs);
        CHECK_HRESULT(hRes)

        hRes = pView->m_pPreviewGraphic->get_RegenType(&pCurRegenMethod);
        CHECK_HRESULT(hRes)

        hRes = pCurRegenMethod->RunPropertyPage(pGrs, &varIndex, &i );
        CHECK_HRESULT(hRes)

        hRes = pView->m_pPreviewView->ZoomToExtents();
        CHECK_HRESULT(hRes)

        pView->Invalidate();
    }
    catch (...)
    {
        TRACE_EXCEPTION("CSdiDialog::OnProperties")
    }

    if (pCurRegenMethod != NULL)
    {
        pCurRegenMethod->Release();
        pCurRegenMethod = NULL;
    }

    if(pGrs != NULL)
    {
        pGrs->Release();
        pGrs = NULL;
    }

}

void CSdiDialog::OnSysCommand(UINT nID, LPARAM lParam )
{
    if (nID == SC_CLOSE)
    {
        if(m_dwEventConnection != 0)
        DisconnectEvents();

        m_pTool->m_bRunned = FALSE;
        if(m_pTool != NULL)
        {
            m_pTool->Release ();
            m_pTool = NULL;
        }

        if(m_pRegMets != NULL)
        {
            m_pRegMets->Release();
            m_pRegMets = NULL;
        }

        CViewWnd *pView = (CViewWnd *)GetDlgItem(IDC_PREVIEW);
        pView->ClearAll();
    }
    CDialog::OnSysCommand(nID, lParam );

}

///------------------------------------------
// DragOutline functions
BOOL CSdiDialog::BeginDrag(const CPoint& point)
{
    VariantClear(&m_dragOutline);
    SAFEARRAYBOUND bound;
    bound.cElements = 0;
    bound.lLbound = 0;
    m_dragOutline.vt = VT_ARRAY|VT_R8;
    m_dragOutline.parray = ::SafeArrayCreate(VT_R8, 1, &bound);

    BoundingBox* Box = NULL;
    IVertex* vMax = NULL;
    IVertex* vMin = NULL;
    double x, y, x1, y1;
    x = x1 = y = y1 = 0;
    try
    {
        HRESULT hRes = m_pDragGraphic->CreateDragOutline(&m_dragOutline);
        CHECK_HRESULT(hRes)

        m_bDragging = TRUE;
        m_pDragGraphic->put_Visible(FALSE);
        VARIANT varState;
        varState.vt = VT_I4;
        varState.lVal = imsiDragBegin;

        hRes = m_pDragGraphic->CalcBoundingBox(NULL, &Box);
        CHECK_HRESULT(hRes)

        hRes = Box->get_Max(&vMax);
        CHECK_HRESULT(hRes)

        hRes = Box->get_Min(&vMin);
        CHECK_HRESULT(hRes)

        hRes = vMax->get_X(&x);
        CHECK_HRESULT(hRes)

        hRes = vMax->get_Y(&y);
        CHECK_HRESULT(hRes)

        hRes = vMin->get_X(&x1);
        CHECK_HRESULT(hRes)

        hRes = vMin->get_Y(&y1);
        CHECK_HRESULT(hRes)

        x = x1 + (x - x1)/2;
        y = y1 + (y - y1)/2;
        hRes = m_pView->ViewToScreen(x, y, &x1, &y1, NULL);
        CHECK_HRESULT(hRes)

        hRes = m_pView->DragOutline(&m_dragOutline, x1, y1, &varState);
        CHECK_HRESULT(hRes)

        varState.lVal = imsiDragContinue;
        hRes = m_pView->DragOutline(&m_dragOutline, point.x, point.y, &varState);
        CHECK_HRESULT(hRes)
    }
    catch (...)
    {
        TRACE_EXCEPTION("CSdiDialog::BeginDrag")
    }
    if (vMin != NULL)
    {
        vMin->Release();
        vMin = NULL;
    }
    if (vMax != NULL)
    {
        vMax->Release();
        vMax = NULL;
    }
    if (Box != NULL)
    {
        Box->Release();
        Box = NULL;
    }

    return TRUE;
}

void CSdiDialog::Drag(const CPoint& point)
{
    if (m_pView == NULL)
        return;

    VARIANT varState;
    varState.vt = VT_I4;
    varState.lVal = imsiDragContinue;

    try
    {
        HRESULT hRes = m_pView->DragOutline(&m_dragOutline, point.x, point.y, &varState);
        CHECK_HRESULT(hRes)
    }
    catch (...)
    {
        TRACE_EXCEPTION("CSdiDialog::Drag")
    }

}

void CSdiDialog::EndDrag(const CPoint& point)
{
    m_bDragging = FALSE;
    if (m_pView == NULL || m_pDragGraphic == NULL)
        return;

    VARIANT varState;
    varState.vt = VT_I4;
    varState.lVal = imsiDragEnd;
    IMatrix *pMat = NULL;

    try
    {
        HRESULT hRes = m_pView->DragOutline(&m_dragOutline, point.x, point.y, &varState);
        CHECK_HRESULT(hRes)

        VariantClear(&m_dragOutline);

        double dx, dy, dz;
        dx = dy = dz = 0;

        double dxWorld, dyWorld, dzWorld;
        dxWorld = dyWorld = dzWorld = 0;
        hRes = m_pView->ScreenToView(point.x, point.y, &dx, &dy);
        CHECK_HRESULT(hRes)

        VARIANT var;
        var.vt = VT_ERROR;
        var.scode = DISP_E_PARAMNOTFOUND;

        ImsiSpaceModeType curMode;

        hRes = m_pView->get_SpaceMode(&curMode);
        CHECK_HRESULT(hRes)
        dxWorld = dx;
        dyWorld = dy;

        if(curMode == imsiModelSpace)
        {
            hRes = m_pView->ViewToWorld(dx, dy, dz, &dxWorld, &dyWorld, &dzWorld);
            CHECK_HRESULT(hRes)
        }
        hRes = m_pDragGraphic->MoveAbsolute(dxWorld, dyWorld, 0, &var, &var, &var, &pMat);
        CHECK_HRESULT(hRes)
        m_pDragGraphic->put_Visible(TRUE);
    }
    catch (...)
    {
        TRACE_EXCEPTION("CSdiDialog::EndDrag")
    }

    if(pMat != NULL)
    {
        pMat->Release();
        pMat = NULL;
    }
    if (m_pDragGraphic != NULL)
    {
        m_pDragGraphic->Release();
        m_pDragGraphic = NULL;
    }

}

void CSdiDialog::RestartDrag(const CPoint& point)
{
    try
    {
        m_bDragging = FALSE;
        VARIANT varState;
        varState.vt = VT_I4;
        varState.lVal = imsiDragEnd;
        HRESULT hRes = m_pView->DragOutline(&m_dragOutline, point.x, point.y, &varState);
        CHECK_HRESULT(hRes)

        VariantClear(&m_dragOutline);
        BeginDrag(point);
    }
    catch (...)
    {
        TRACE_EXCEPTION("CSdiDialog::RestartDrag")
    }

}

void CSdiDialog::DrawingBeforeClose(LPDISPATCH WhichDrawing, BOOL FAR* Cancel)
{
    *Cancel = FALSE;
    Drawings *pDrs = NULL;
    long n = 0;

    try
    {
        HRESULT hRes = m_pIApplication->get_Drawings(&pDrs);
        CHECK_HRESULT(hRes)
        hRes = pDrs->get_Count(&n);
        CHECK_HRESULT(hRes)

        if (n == 2)
        {

        if(m_dwEventConnection != 0)
            DisconnectEvents();
            m_pTool->m_bRunned = FALSE;

            CViewWnd *pView = (CViewWnd *)GetDlgItem(IDC_PREVIEW);
            pView->ClearAll();
            CSdiDialog::OnClose();
        }

    }

    catch (...)
    {

        TRACE_EXCEPTION("CSdiDialog::DrawingBeforeClose")
    }
    if (pDrs != NULL)
    {
        pDrs->Release();
        pDrs = NULL;
    }

}


Examples - C++ Insert Regen Object Tool - SdiDialog.h

SdiDialog.h

C++ Insert Regen Object Tool Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
#if !defined(AFX_SDIDIALOG_H__13F08AB3_207F_11D2_A4B4_0000B465872B__INCLUDED_)
#define AFX_SDIDIALOG_H__13F08AB3_207F_11D2_A4B4_0000B465872B__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000
// SdiDialog.h : header file
//
#include "Toollist.h"
#include "ViewWnd.h"
#include "SmObj.h"

/////////////////////////////////////////////////////////////////////////////
// CSdiDialog dialog

class CSdiDialog : public CDialog
{
// Construction
public:
    BOOL BeginDrag(const CPoint& point);
    void Drag(const CPoint& point);
    void RestartDrag(const CPoint& point);
    void EndDrag(const CPoint& point);
    bool m_FirstClick;
    CToolList m_list;
    CViewWnd m_wndView;

    VARIANT m_dragOutline;
    IGraphic* m_pDragGraphic;
    BOOL m_bDragging;
    RegenMethods *m_pRegMets;

    HRESULT hRes;/// = S_OK;
    DWORD m_dwEventConnection;

    CString m_selected;
    CSdiDialog(CInsSmObj* pTool, CWnd* pParent, RegenMethods *pRegMets);   // standard constructor

// Dialog Data
    //{{AFX_DATA(CSdiDialog)
    enum { IDD = IDD_DIALOG1 };
    CString	m_listbox;
    //}}AFX_DATA

    ///	Graphics* m_pGrsVirt;
    void ConnectEvents();
    void DisconnectEvents();

    DECLARE_MESSAGE_MAP()

    afx_msg void BeforeExit(LPDISPATCH TheApp, BOOL FAR* Cancel);
    afx_msg void DrawingNew(LPDISPATCH WhichDrawing);
    afx_msg void DrawingOpen(LPDISPATCH WhichDrawing);
    afx_msg void DrawingActivate(LPDISPATCH WhichDrawing);
    afx_msg void DrawingDeactivate(LPDISPATCH WhichDrawing);
    afx_msg void DrawingBeforeClose(LPDISPATCH WhichDrawing, BOOL FAR* Cancel);
    afx_msg void DrawingBeforeSave(LPDISPATCH WhichDrawing, BOOL FAR* SaveAs, BOOL FAR* Cancel);
    afx_msg void WindowResize(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow);
    afx_msg void WindowActivate(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow);
    afx_msg void WindowDeactivate(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow);

    afx_msg void MouseDown(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel);
    afx_msg void MouseUp(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel);
    afx_msg void MouseMove(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, long Shift, long X, long Y, IMSI_BOOL* pbCancel);

    afx_msg void BeforeDoubleClick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel, BOOL FAR* Cancel);
    afx_msg void BeforeRightClick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel, BOOL FAR* Cancel);
    afx_msg void SelectionChange(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel);
    afx_msg void CommandBarControlHit(LPDISPATCH WhichControl, BOOL FAR* Cancel);
    afx_msg void CommandBarControlStatus(LPDISPATCH WhichControl);
    afx_msg void RunTool(LPDISPATCH WhichTool);
    afx_msg void PointSnapped(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, long XScreen, long YScreen, LPDISPATCH PointRaw, LPDISPATCH PointSnapped);
    afx_msg void PointPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled);
    afx_msg void RectanglePick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled);
    afx_msg void PolygonPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled);
    afx_msg void ViewBeforeRedraw(LPDISPATCH WhichDrawing, LPDISPATCH WhichView);
    afx_msg void ViewAfterRedraw(LPDISPATCH WhichDrawing, LPDISPATCH WhichView);
    afx_msg void VirtualIntersectionPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH PickResult, BOOL WasCanceled);
    afx_msg void CommandBarControlDone(LPDISPATCH WhichControl);
    afx_msg void Drop(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Selection);

    //}}AFX_DISPATCH
    DECLARE_DISPATCH_MAP()
    DECLARE_INTERFACE_MAP()

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CSdiDialog)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    virtual void PostNcDestroy();
    //}}AFX_VIRTUAL

// Implementation
protected:
    CInsSmObj *m_pTool;
    HICON m_hIcon;

    View* m_pView;
    CPoint m_ptMouseDown;

    // TurboCAD SDK:  Pointer to the running application.
    IApplication* m_pIApplication;
    DWORD m_dwEventMask;

    // Generated message map functions
    //{{AFX_MSG(CSdiDialog)
    virtual BOOL OnInitDialog();
    afx_msg void OnClose();
    afx_msg void OnProperties();
    afx_msg void OnSysCommand(UINT nID, LPARAM lParam );
    //}}AFX_MSG
    afx_msg void OnEventMask(UINT nID);

};

//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_SDIDIALOG_H__13F08AB3_207F_11D2_A4B4_0000B465872B__INCLUDED_)


Examples - C++ Insert Regen Object Tool - SmObj.cpp

SmObj.cpp

C++ Insert Regen Object Tool Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// Tool.cpp : Implementation of CDCMTool
#include "stdafx.h"
#include "InsSmObj.h"
#include "SmObj.h"
#include "SdiDialog.h"

#include <afxwin.h>

const IID IID_Tool = {0x6A48112C,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_IApplication = {0x6A481101,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

/////////////////////////////////////////////////////////////////////////////

STDMETHODIMP CInsSmObj::InterfaceSupportsErrorInfo(REFIID riid)
{
    static const IID* arr[] =
    {
        &IID_ITurboCADTool,
    };
    for (int i=0;i<sizeof(arr)/sizeof(arr[0]);i++)
    {
        if (InlineIsEqualGUID(*arr[i],riid))
            return S_OK;
    }
    return S_FALSE;
}

    /* ITurboCADTool properties: */
STDMETHODIMP CInsSmObj::get_ClassID(BSTR* retval)
{
    HRESULT hRes = E_FAIL;
    LPOLESTR olestr = NULL;

    try
    {
        *retval = NULL;

        hRes = ::StringFromCLSID(CLSID_InsSmObj, &olestr);
        CHECK_HRESULT(hRes)

        *retval = ::SysAllocString(olestr);

        hRes = S_OK;
    }
    catch (...)
    {
        TRACE_EXCEPTION("CInsSmObj::get_ClassID")
    }

    if (olestr != NULL)
        CoTaskMemFree(olestr);

    return hRes;
}

STDMETHODIMP CInsSmObj::get_Description( BSTR* retval)
{

    HRESULT hRes = E_FAIL;
    CString strResult;
    *retval = NULL;

    try
    {
        if (strResult.LoadString(IDS_DESCRIPTION))

            hRes = S_OK;
            *retval = strResult.AllocSysString();

    }
    catch (...)
    {
        TRACE_EXCEPTION("CInsSmObj::get_Description")
    }

    return hRes;

}

/* ITurboCADTool methods: */
STDMETHODIMP CInsSmObj::GetToolInfo(VARIANT FAR* CommandNames,
                                   VARIANT FAR* MenuCaptions,
                                   VARIANT FAR* StatusPrompts,
                                   VARIANT FAR* ToolTips,
                                   VARIANT FAR* Enabled,
                                   VARIANT FAR* WantsUpdates,
                                   long FAR* retval)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());

    HRESULT hRes = E_FAIL;

    SAFEARRAYBOUND bound = {NUM_TOOLS, 0};

    CString cstrText;
    CString cstrTextTemp;

    BSTR bstrCommandName = NULL;
    BSTR bstrMenuCaption = NULL;
    BSTR bstrStatusPrompt = NULL;
    BSTR bstrToolTip = NULL;
    BOOL bEnabled = TRUE;
    BOOL bWantsUpdates = TRUE;

    long lIndicies = 0;
    try
    {

        hRes = SafeArrayRedim(CommandNames->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(MenuCaptions->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(StatusPrompts->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(ToolTips->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(Enabled->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(WantsUpdates->parray, &bound);
        CHECK_HRESULT(hRes)

        //CString cstrText="SDK|Smart Object"; //# Localizable string#
        cstrText.LoadString (IDS_MAINMENU);
        cstrText.Insert(cstrText.GetLength (), '|');
        cstrTextTemp.LoadString (IDS_SUBMENU);
        cstrText.Insert(cstrText.GetLength (), cstrTextTemp);
        cstrText.Insert(cstrText.GetLength (), '|');
        cstrTextTemp.LoadString (IDS_MENUCAPTION);
        cstrText.Insert(cstrText.GetLength (), cstrTextTemp);
        cstrTextTemp.Empty ();

        bstrCommandName = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(CommandNames->parray, &lIndicies, (void *)bstrCommandName);
        CHECK_HRESULT(hRes)

        cstrText.Empty ();
        cstrText.LoadString (IDS_MENUCAPTION);
        bstrMenuCaption = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(MenuCaptions->parray, &lIndicies, (void *)bstrMenuCaption);
        CHECK_HRESULT(hRes)

          cstrText.LoadString (IDS_PROMT);
        bstrStatusPrompt = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(StatusPrompts->parray, &lIndicies, (void *)bstrStatusPrompt);
        CHECK_HRESULT(hRes)

        cstrText.LoadString (IDS_TOOLTIPS);
        bstrToolTip = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(ToolTips->parray, &lIndicies, (void *)bstrToolTip);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayPutElement(Enabled->parray, &lIndicies, (void *)&bEnabled);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayPutElement(WantsUpdates->parray, &lIndicies, (void *)&bWantsUpdates);
        CHECK_HRESULT(hRes)

        *retval = NUM_TOOLS;
    }
    catch (...)
    {
        if (SUCCEEDED(hRes))
            hRes = E_FAIL;
        TRACE_EXCEPTION("CInsSmObj::GetToolInfo")
    }
    return hRes;
}

STDMETHODIMP CInsSmObj::CopyBitmap( VARIANT_BOOL LargeButtons, VARIANT_BOOL Monochrome, VARIANT_BOOL FAR* retval)
{
    HRESULT hRes = E_FAIL;
    try
    {
        CHECK_HRESULT(hRes)
        hRes = S_OK;
    }
    catch (...)
    {
        TRACE_EXCEPTION("CInsSmObj::CopyBitmap")
    }
    return hRes;
}

STDMETHODIMP CInsSmObj::GetPicture( VARIANT_BOOL LargeButtons, VARIANT_BOOL Monochrome, IDispatch** retval)
{
    HRESULT hRes = E_FAIL;
    try
    {
        CHECK_HRESULT(hRes)
        hRes = S_OK;
    }
    catch (...)
    {
        TRACE_EXCEPTION("CInsSmObj::GetPicture")
    }
    return hRes;
}

STDMETHODIMP CInsSmObj::Run( IDispatch* ThisTool, VARIANT_BOOL FAR* retval)
{
    CWnd *pMainWnd = AfxGetMainWnd();
    AFX_MANAGE_STATE(AfxGetStaticModuleState());

    CInsSmObjApp *pApp = (CInsSmObjApp *)AfxGetApp();

    HRESULT hRes = E_FAIL;

    Tool *pTool = NULL;
    IApplication *pIApp = NULL;

    RegenMethods *pRegMets=NULL;
    RegenMethod *pIRegMet=NULL;

    COleVariant varAperture(0.2);
    COleVariant varItem;
    long lItem = 0;
    long lIndex = 0;

    COleVariant varOptional(varMissing);
    COleVariant varType((const long)imsiPolyline);

    VARIANT_BOOL	varCopy = FALSE;
    VARIANT_BOOL	varRetval = FALSE;

    long lID = 0;

    BSTR bstrType = NULL;
    CString	strType;

    BSTR bstrDescription=NULL;
    CString strDescription;

    BSTR bstrName=NULL;
    CString strName;

    HCURSOR hOC = ::SetCursor(::LoadCursor(NULL,IDC_WAIT));

    try
    {
        hRes = ThisTool->QueryInterface(IID_Tool, (void **)&pTool);
        CHECK_HRESULT(hRes)

        hRes = pTool->get_Application(&pIApp);
        CHECK_HRESULT(hRes)

         hRes = pIApp->get_RegenMethods(&pRegMets);
        CHECK_HRESULT(hRes)

        CSdiDialog *pdlg = new CSdiDialog(this, pMainWnd, pRegMets);

        pdlg->Create(CSdiDialog::IDD, NULL /*pMainWnd*/);

        VARIANT_BOOL	varRetval1 = FALSE;

//		hRes = UpdateToolStatus(ThisTool, FALSE, FALSE, &varRetval1);
        hRes = UpdateToolStatus(ThisTool, &varRetval1, &varRetval1, &varRetval1);
        CHECK_HRESULT(hRes)

        hRes = S_OK;
    }
    catch (...)
    {
        TRACE_EXCEPTION("CInsSmObj::Run")
    }
    ::SetCursor(hOC);

    if(pRegMets != NULL)
    {
        pRegMets->Release();
        pTool = NULL;
    }

    RELEASE(pIApp)
    RELEASE(pTool)

    return hRes;
}

STDMETHODIMP CInsSmObj::UpdateToolStatus(IDispatch* ThisTool, VARIANT_BOOL FAR* Enabled, VARIANT_BOOL FAR* Checked, VARIANT_BOOL FAR* retval)
{
    HRESULT hRes = E_FAIL;

    try
    {
        if(m_bRunned == TRUE)
        {
            *Enabled = FALSE;
        }
        *retval = TRUE;
        hRes = S_OK;

    }
    catch (...)
    {
        TRACE_EXCEPTION("CInsSmObj::UpdateToolStatus")
    }

    return hRes;
}

STDMETHODIMP CInsSmObj::Initialize( IDispatch * ThisTool, VARIANT_BOOL FAR* retval)
{
    HRESULT hRes = E_FAIL;

    try
    {
        *retval = TRUE;
        hRes = S_OK;

    }
    catch (...)
    {
        TRACE_EXCEPTION("CInsSmObj::Initialize")
    }
    return hRes;
}


Examples - C++ Insert Regen Object Tool - SmObj.h

SmObj.h

C++ Insert Regen Object Tool Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// Tool.h : Declaration of the CAALBTool

#ifndef __INSSMOBJ_H_
#define __INSSMOBJ_H_

#include "resource.h"       // main symbols

/////////////////////////////////////////////////////////////////////////////
// CAALBTool
class ATL_NO_VTABLE CInsSmObj :
    public CComObjectRootEx<CComSingleThreadModel>,
    public CComCoClass<CInsSmObj, &CLSID_InsSmObj>,
    public ISupportErrorInfo,
    public CComDualImpl<ITurboCADTool, &IID_ITurboCADTool, &LIBID_INSSMOBJLib, TYPELIB_MAJOR, TYPELIB_MINOR>
{
public:
    CInsSmObj()
    {
        m_bRunned = false;
    }

DECLARE_REGISTRY_RESOURCEID(IDR_INSSMOBJ)
DECLARE_CLASSFACTORY_SINGLETON(CInsSmObj)

BEGIN_COM_MAP(CInsSmObj)
    COM_INTERFACE_ENTRY(ITurboCADTool)
    COM_INTERFACE_ENTRY(IDispatch)
    COM_INTERFACE_ENTRY(ISupportErrorInfo)
END_COM_MAP()

// ISupportsErrorInfo
    STDMETHOD(InterfaceSupportsErrorInfo)(REFIID riid);

public:
    /* ITurboCADTool properties: */
    BOOL m_bRunned;
    STDMETHOD(get_ClassID)(THIS_ BSTR* retval);
    STDMETHOD(get_Description)(THIS_ BSTR* retval);

    /* ITurboCADTool methods: */
    STDMETHOD(GetToolInfo)(THIS_ VARIANT FAR* CommandNames, VARIANT FAR* MenuCaptions, VARIANT FAR* StatusPrompts, VARIANT FAR* ToolTips, VARIANT FAR* Enabled, VARIANT FAR* WantsUpdates, long FAR* retval);
    STDMETHOD(CopyBitmap)(THIS_ VARIANT_BOOL LargeButtons, VARIANT_BOOL Monochrome, VARIANT_BOOL FAR* retval);
    STDMETHOD(GetPicture)(THIS_ VARIANT_BOOL LargeButtons, VARIANT_BOOL Monochrome, IDispatch** retval);
    STDMETHOD(Run)(THIS_ IDispatch* ThisTool, VARIANT_BOOL FAR* retval);
    STDMETHOD(UpdateToolStatus)(THIS_ IDispatch* ThisTool, VARIANT_BOOL FAR* Enabled, VARIANT_BOOL FAR* Checked, VARIANT_BOOL FAR* retval);
    STDMETHOD(Initialize)(THIS_ IDispatch * ThisTool, VARIANT_BOOL FAR* retval);
};

#endif //__AALBTOOL_H_


Examples - C++ Insert Regen Object Tool - ToolList.cpp

ToolList.cpp

C++ Insert Regen Object Tool Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// ToolList.cpp : implementation file
//

#include "stdafx.h"
#include "InsSmObj.h"
#include "ToolList.h"
#include "SdiDialog.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CToolList

CToolList::CToolList()
{
}

CToolList::~CToolList()
{
}

BEGIN_MESSAGE_MAP(CToolList, CListBox)
    //{{AFX_MSG_MAP(CToolList)
    ON_WM_MOUSEMOVE()
    ON_WM_LBUTTONUP()
    ON_CONTROL_REFLECT(LBN_SELCHANGE, OnSelchange)
    ON_WM_LBUTTONDOWN()
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CToolList message handlers

void CToolList::OnMouseMove(UINT nFlags, CPoint point)
{
    // TODO: Add your message handler code here and/or call default
    if(nFlags & MK_LBUTTON)
    {

        int dx = m_LB_DOWNpoint.x - point.x;
        int dy = m_LB_DOWNpoint.y - point.y;
        CPoint Pt = point;

        if((abs(dx) > 1 || abs(dy) > 1) && m_drag)
        {
// if dragging
            if (((CSdiDialog*)GetParent())->m_dwEventConnection == 0)
            {
                ((CSdiDialog*)GetParent())->ConnectEvents();
            }
                m_OldCursor = GetCursor();
                m_NewCursor = LoadCursor(AfxGetInstanceHandle( ), MAKEINTRESOURCE(IDC_CURSOR1));
                SetCursor(m_NewCursor);
                ShowCursor(TRUE);
                m_drag = FALSE;
                m_LB_DOWNpoint.x = -1;
                m_LB_DOWNpoint.y = -1;
                ((CSdiDialog*)GetParent())->m_FirstClick = TRUE;
                return;

        }

        ClientToScreen(&Pt);
        CWnd *pClickWNd = WindowFromPoint(Pt);

        if(pClickWNd && pClickWNd != this)
        {
            pClickWNd->ScreenToClient(&Pt);
            pClickWNd->PostMessage(WM_MOUSEMOVE, nFlags, MAKELONG(Pt.x, Pt.y));
        }

    }
 }

void CToolList::OnLButtonUp(UINT nFlags, CPoint point)
{
    CListBox::OnLButtonUp(nFlags, point);
    m_drag = FALSE;

    CPoint Pt = point;
    ClientToScreen(&Pt);
    CWnd *pClickWNd = WindowFromPoint(Pt);

    if(pClickWNd && pClickWNd != this)
    {
        pClickWNd->ScreenToClient(&Pt);
        pClickWNd->PostMessage(WM_LBUTTONUP, nFlags, MAKELONG(Pt.x, Pt.y));
        SetCursor(m_OldCursor);
        ShowCursor(TRUE);
        return;

    }
    else
    {
        SetCursor(m_OldCursor);
        ShowCursor(TRUE);

    }
}

void CToolList::OnSelchange()

{
    // TODO: Add your control notification handler code here

    CListBox *pList = (CListBox *) (GetParent()->GetDlgItem(IDC_LIST1));

    HCURSOR hOC = ::SetCursor(::LoadCursor(NULL,IDC_WAIT));

    int index = pList->GetCurSel();
    CString cstrSelected;

    pList->GetText(index, cstrSelected);
    if (m_cstrCurSelected != cstrSelected) // check if the current selection is changed
    {
        CViewWnd *m_wndView = (CViewWnd *) (((CSdiDialog*)GetParent())->GetDlgItem(IDC_PREVIEW));
        m_wndView->Clear();

        m_wndView->DoPreview();
        m_cstrCurSelected = cstrSelected;
        m_wndView->Invalidate();
    }
    ::SetCursor(hOC);

}

void CToolList::OnLButtonDown(UINT nFlags, CPoint point)
{
    // TODO: Add your message handler code here and/or call default

    BOOL ret;

    CListBox::OnLButtonDown(nFlags, point);
    m_drag = TRUE;
    m_LB_DOWNpoint.x = point.x;
    m_LB_DOWNpoint.y = point.y;

    CString cstrSelected;

    GetText(ItemFromPoint(point, ret), cstrSelected);

    if (m_cstrCurSelected != cstrSelected) // check if the current selection is changed
    {
        BeginWaitCursor();
        CViewWnd *m_wndView = (CViewWnd *) (((CSdiDialog*)GetParent())->GetDlgItem(IDC_PREVIEW));
        m_wndView->Clear();

        m_wndView->DoPreview();
        m_cstrCurSelected = cstrSelected;
        m_wndView->Invalidate();
        EndWaitCursor();
    }

}


Examples - C++ Insert Regen Object Tool - ToolList.h

ToolList.h

C++ Insert Regen Object Tool Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
#if !defined(AFX_TOOLLIST_H__38D78325_64F1_11D2_82CE_006052012837__INCLUDED_)
#define AFX_TOOLLIST_H__38D78325_64F1_11D2_82CE_006052012837__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000
// ToolList.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CToolList window

class CToolList : public CListBox
{
// Construction
public:
    CToolList();

// Attributes
public:
    HCURSOR m_OldCursor;
    HCURSOR m_NewCursor;

// Operations
public:

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CToolList)
    //}}AFX_VIRTUAL

// Implementation
public:
    CString m_cstrCurSelected;
    CPoint m_LB_DOWNpoint;
    BOOL m_drag;
    virtual ~CToolList();

    // Generated message map functions
protected:
    //{{AFX_MSG(CToolList)
    afx_msg void OnMouseMove(UINT nFlags, CPoint point);
    afx_msg void OnLButtonUp(UINT nFlags, CPoint point);
    afx_msg void OnSelchange();
    afx_msg void OnLButtonDown(UINT nFlags, CPoint point);
    //}}AFX_MSG

    DECLARE_MESSAGE_MAP()
};

/////////////////////////////////////////////////////////////////////////////

//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_TOOLLIST_H__38D78325_64F1_11D2_82CE_006052012837__INCLUDED_)


Examples - C++ Insert Regen Object Tool - ViewWnd.cpp

ViewWnd.cpp

C++ Insert Regen Object Tool Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
// ViewWnd.cpp : implementation file
//

#include "stdafx.h"
#include "InsSmObj.h"
#include "ViewWnd.h"
#include "SdiDialog.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CViewWnd

CViewWnd::CViewWnd()
{
    m_FirstStart = TRUE;
    m_pIApp = NULL;
    m_pDrawCol = NULL;
    m_pPreviewDrawing = NULL;
    m_pPreviewGrs = NULL;
    m_pPreviewView = NULL;
    m_pViewsCol = NULL;
    m_pPreviewGraphic = NULL;

}

CViewWnd::~CViewWnd()
{
}

BEGIN_MESSAGE_MAP(CViewWnd, CWnd)
    //{{AFX_MSG_MAP(CViewWnd)
    ON_WM_PAINT()
    ON_WM_ERASEBKGND()
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CViewWnd message handlers

void CViewWnd::OnPaint()
{
    CPaintDC dc(this); // device context for painting

    if (m_pPreviewView == NULL)
        return;

    // Force redraw of view window
    try
    {
        HRESULT hRes = m_pPreviewView->Refresh();
                CHECK_HRESULT(hRes)

    }	// TODO: Add your message handler code here

    catch (...)
    {
        TRACE_EXCEPTION("CViewWnd::OnPaint")
    }
        // Do not call CWnd::OnPaint() for painting messages
}

BOOL CViewWnd::OnEraseBkgnd(CDC* pDC)
{
    // TODO: Add your message handler code here and/or call default
    CRect rect;
    GetClientRect(rect);
    pDC->FillSolidRect(rect, ::GetSysColor(COLOR_WINDOW));
    return TRUE;

///	return CWnd::OnEraseBkgnd(pDC);
}

void CViewWnd::CreatePreview() //create a preview drawing
{
    HRESULT hRes;
    COleVariant varType((const long)imsiPolyline);
    COleVariant varOptional(varMissing);

    try
    {
        if (m_FirstStart == TRUE)
        {

            ClearAll();
//			HMODULE	hDBAPI = GetModuleHandle(DBAPI);
//			if (hDBAPI == NULL)
//				return;
            HMODULE hDBAPI = GetModuleHandle(DBAPI70);
            if (hDBAPI == NULL)
            {
                hDBAPI = GetModuleHandle(DBAPI60);

                if (hDBAPI == NULL)
                {
                    hDBAPI = GetModuleHandle(DBAPI50);
                }
            }

            if (hDBAPI == NULL)
                return;
            else
                m_pfGetApp = (APPGETCURRENTAPP)GetProcAddress(hDBAPI, _T("AppGetCurrentApp"));
                if (m_pfGetApp == NULL)
                return;

            m_lApp = (*m_pfGetApp)();
            if (m_lApp == 0)
            return;

            m_pfAppDwgNew = (APPDRAWINGNEWEX)GetProcAddress(hDBAPI, _T("AppDrawingNewEx"));
            if (m_pfAppDwgNew == NULL)
                {
                    AfxMessageBox("m_pfAppDwgNew ==	NULL");//# Non-localizable string#

                }

            BOOL i;
            i = TRUE;
            m_lDwg = (*m_pfAppDwgNew)(m_lApp, i, NULL, NULL);

            COleVariant varItem = (0L);
            long nDrawings = 0;

            hRes = ((CSdiDialog*)GetParent())->m_pRegMets->get_Application(&m_pIApp);
            CHECK_HRESULT(hRes)

            hRes = m_pIApp->get_Drawings(&m_pDrawCol);
            CHECK_HRESULT(hRes)

            hRes = m_pDrawCol->get_Count(&nDrawings);
            CHECK_HRESULT(hRes)

            varItem = nDrawings - 1L;

            hRes = m_pDrawCol->get_Item(&varItem, &m_pPreviewDrawing);

            hRes = m_pPreviewDrawing->get_Views(&m_pViewsCol);

            long nViews = 0;

            HWND hWnd = ::GetDlgItem(GetParent()->m_hWnd, IDC_PREVIEW);
            COleVariant varHwnd((long)hWnd);

            hRes = m_pViewsCol->Add(&varHwnd, &varOptional, &m_pPreviewView );
            CHECK_HRESULT(hRes)

            hRes = m_pPreviewView->put_Update(FALSE);
            CHECK_HRESULT(hRes)

            hRes = m_pPreviewView->put_MappingMode(MM_TEXT);
            CHECK_HRESULT(hRes)

            hRes = m_pPreviewView->put_FixedAspectRatio(TRUE);
            CHECK_HRESULT(hRes)

            hRes = m_pPreviewView->put_Margins(FALSE);
            CHECK_HRESULT(hRes)

            CViewWnd *pPreview = (CViewWnd *) (((CSdiDialog*)GetParent())->GetDlgItem(IDC_PREVIEW));

            CRect rcBounds;
            pPreview->GetClientRect(&rcBounds);

            hRes = m_pPreviewView->put_ScreenLeft(rcBounds.left);
            CHECK_HRESULT(hRes)

            hRes = m_pPreviewView->put_ScreenTop(rcBounds.top);
            CHECK_HRESULT(hRes)

            hRes = m_pPreviewView->put_ScreenWidth(rcBounds.Width());
            CHECK_HRESULT(hRes)

            hRes = m_pPreviewView->put_ScreenHeight(rcBounds.Height());
            CHECK_HRESULT(hRes)

            hRes = m_pPreviewView->ZoomToExtents();
            CHECK_HRESULT(hRes)

//			hRes = m_pPreviewDrawing->get_Graphics(&m_pPreviewGrs);
//			CHECK_HRESULT(hRes)

        /// display preview on first item immediately after dialog is open

            m_FirstStart = FALSE;
        }

    }

    catch (...)
    {
        TRACE_EXCEPTION("CViewWnd::CreatePreview")
    }

}

void CViewWnd::Clear()
{

    if (m_pPreviewGraphic != NULL)
    {
        m_pPreviewGraphic->put_Deleted(TRUE);
        m_pPreviewGraphic->Release();
        m_pPreviewGraphic = NULL;
    }

    Invalidate();

}

void CViewWnd::ClearAll()
{
    if (m_pPreviewGraphic != NULL)
    {
//		m_pPreviewGraphic->Delete();
        m_pPreviewGraphic->put_Deleted(TRUE);
        m_pPreviewGraphic->Release();
        m_pPreviewGraphic = NULL;
    }
    if (m_pPreviewGrs != NULL)
    {
        m_pPreviewGrs->Release();
        m_pPreviewGrs = NULL;

    }
    if (m_pPreviewView != NULL)
    {
        m_pPreviewView->Release();
        m_pPreviewView = NULL;

    }
    if (m_pViewsCol != NULL)
    {
        m_pViewsCol->Release();
        m_pViewsCol = NULL;

    }
    if (m_pPreviewDrawing != NULL)
    {
        COleVariant varOptional(varMissing);
        m_pPreviewDrawing->Close(varOptional, varOptional, varOptional);
        m_pPreviewDrawing->Release();
        m_pPreviewDrawing = NULL;

    }

    if (m_pDrawCol != NULL)
    {
        m_pDrawCol->Release();
        m_pDrawCol = NULL;

    }

    if (m_pIApp != NULL)
    {
        m_pIApp->Release();
        m_pIApp = NULL;

    }
    m_FirstStart = TRUE;

}

void CViewWnd::DoPreview()
{
    HRESULT hRes;
//	COleVariant varType((const long)imsiPolyline);
    COleVariant varType((const long)imsiGroup);
    COleVariant varOptional(varMissing);
    IDrawing *pIDwg = NULL;
    ImsiSpaceModeType curMode;
    IApplication *pIApp = NULL;
    Properties *pProps = NULL;
    Property *pProp = NULL;
    Properties *pProps1 = NULL;
    Property *pProp1 = NULL;
    COleVariant varVal;//(1L);

    try
    {

// set PreviewDrawing Mode the same like active drawing

        hRes = ((CSdiDialog*)GetParent())->m_pRegMets->get_Application(&pIApp);
        CHECK_HRESULT(hRes)

        hRes = pIApp->get_ActiveDrawing(&pIDwg);
        CHECK_HRESULT(hRes)

        CString cstrName("TileMode");//# Non-localizable string#
        BSTR bstrName = cstrName.AllocSysString();

        VARIANT varItem1;
        ::VariantInit(&varItem1);
        varItem1.vt = VT_BSTR;
        varItem1.bstrVal = bstrName;

// get properties of current active  drawing
        hRes = pIDwg->get_Properties(&pProps);
        CHECK_HRESULT(hRes)

        hRes = pProps->get_Item(&varItem1, &pProp);
        CHECK_HRESULT(hRes)

        hRes = pProp->get_Value(NULL, varVal);
        CHECK_HRESULT(hRes)

// get properties of Preview drawing
        hRes = m_pPreviewDrawing->get_Properties(&pProps1);
        CHECK_HRESULT(hRes)

        hRes = pProps1->get_Item(&varItem1, &pProp1);
        CHECK_HRESULT(hRes)

        if (varVal.lVal == 1)
        {
            hRes = pProp1->put_Value(NULL, varVal);
            CHECK_HRESULT(hRes)
        }
        else
        {
            hRes = pProp1->put_Value(NULL, varVal);
            CHECK_HRESULT(hRes)
        }
        Invalidate();

        ::VariantClear(&varItem1);

        CToolList *pList = (CToolList *) (GetParent()->GetDlgItem(IDC_LIST1));

        int index = pList->GetCurSel();

        pList->GetText(index, m_cstrSelected);

        COleVariant varRegen(m_cstrSelected);
        hRes = m_pPreviewDrawing->get_Graphics(&m_pPreviewGrs);

        CHECK_HRESULT(hRes)
         hRes = m_pPreviewGrs->Add(&varRegen,
                         &varRegen,
                         &varOptional,
                         &varOptional,
                         &varOptional,
                         &varOptional,
                         &m_pPreviewGraphic);
/*
        hRes = m_pPreviewGrs->Add(&varType,
                         &varRegen,
                         &varOptional,
                         &varOptional,
                         &varOptional,
                         &varOptional,
                         &m_pPreviewGraphic);

*/
        CHECK_HRESULT(hRes)

//		if (m_pPreviewGraphic == NULL)
//			return;

        hRes = m_pPreviewView->ZoomToExtents();
        CHECK_HRESULT(hRes)

//		hRes = m_pPreviewView->Refresh();
//		CHECK_HRESULT(hRes)
    }

    catch (...)
    {
        TRACE_EXCEPTION("CViewWnd::DoPreview")
    }

    if (pProp1 != NULL)
        pProp1->Release();

    if (pProps1 != NULL)
        pProps1->Release();

    if (pProp != NULL)
        pProp->Release();

    if (pProps != NULL)
        pProps->Release();

    if (pIDwg != NULL)
        pIDwg->Release();

}


Examples - C++ Insert Regen Object Tool - ViewWnd.h

ViewWnd.h

C++ Insert Regen Object Tool Example

/******************************************************************/
/*                                                                */
/*                      TurboCAD for Windows                      */
/*                   Copyright (c) 1993 - 1999                    */
/*             International Microcomputer Software, Inc.         */
/*                            (IMSI)                              */
/*                      All rights reserved.                      */
/*                                                                */
/******************************************************************/
#if !defined(AFX_VIEWWND_H__101E4613_73CC_11D2_82DA_006052012837__INCLUDED_)
#define AFX_VIEWWND_H__101E4613_73CC_11D2_82DA_006052012837__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000
// ViewWnd.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CViewWnd window

class CViewWnd : public CWnd
{
// Construction
public:
    CViewWnd();

// Attributes
public:
    IDrawing *m_pPreviewDrawing;
    View *m_pPreviewView;

    IGraphic *m_pPreviewGraphic;
    Graphics *m_pPreviewGrs;/// = NULL;

    Views *m_pViewsCol;
    IApplication *m_pIApp;/// = NULL;
    Drawings *m_pDrawCol;

    BOOL	m_FirstStart;
    APPDRAWINGNEWEX m_pfAppDwgNew;
    APPGETCURRENTAPP m_pfGetApp;
    long m_lApp;
    long m_lDwg;
    CString m_cstrSelected;

// Operations
public:

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CViewWnd)
    //}}AFX_VIRTUAL

// Implementation
    // Zoom to the extents of the drawing and refresh the window
    void ZoomAndInvalidate();

public:
    void DoPreview();
    void ClearAll();
    void Clear();
    void DisplayPreview();
    void CreatePreview();
    virtual ~CViewWnd();

    // Generated message map functions
protected:
    //{{AFX_MSG(CViewWnd)
    afx_msg void OnPaint();
    afx_msg BOOL OnEraseBkgnd(CDC* pDC);
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

/////////////////////////////////////////////////////////////////////////////

//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_VIEWWND_H__101E4613_73CC_11D2_82DA_006052012837__INCLUDED_)


Examples - C++ Insert Symbol Tool - dirdialog.CPP

dirdialog.CPP

C++ Insert Symbol Tool Example

///////////////////////////////////////////////////////////////////////////
// DirDialog.cpp: implementation of the CDirDialog class.
//
//////////////////////////////////////////////////////////////////////

#include "stdafx.h"
#include "DirDialog.h"
#include "shlobj.h"

#ifdef _DEBUG
#undef THIS_FILE
static char THIS_FILE[]=__FILE__;
#define new DEBUG_NEW
#endif

// Callback function called by SHBrowseForFolder's browse control
// after initialization and when selection changes
static int __stdcall BrowseCtrlCallback(HWND hwnd, UINT uMsg, LPARAM lParam, LPARAM lpData)
{
  CDirDialog* pDirDialogObj = (CDirDialog*)lpData;

  if (uMsg == BFFM_INITIALIZED && !pDirDialogObj->m_strSelDir.IsEmpty())
  {
    ::SendMessage(hwnd, BFFM_SETSELECTION, TRUE, (LPARAM)(LPCTSTR)(pDirDialogObj->m_strSelDir));
  }
  else // uMsg == BFFM_SELCHANGED
  {
  }

  return 0;
}

//////////////////////////////////////////////////////////////////////
// Construction/Destruction
//////////////////////////////////////////////////////////////////////

CDirDialog::CDirDialog()
{
}

CDirDialog::~CDirDialog()
{
}

int CDirDialog::DoBrowse( HWND oWner)
{
  LPMALLOC pMalloc;
  if (SHGetMalloc (&pMalloc)!= NOERROR)
  {
      return 0;
  }

  BROWSEINFO bInfo;
  LPITEMIDLIST pidl;
  ZeroMemory ( (PVOID) &bInfo,sizeof (BROWSEINFO));

  if (!m_strInitDir.IsEmpty ())
  {
    OLECHAR       olePath[MAX_PATH];
    ULONG         chEaten;
    ULONG         dwAttributes;
    HRESULT       hr;
    LPSHELLFOLDER pDesktopFolder;
    //
    // Get a pointer to the Desktop's IShellFolder interface.
    //
    if (SUCCEEDED(SHGetDesktopFolder(&pDesktopFolder)))
    {
      //
      // IShellFolder::ParseDisplayName requires the file name be in Unicode.
      //
      MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, m_strInitDir.GetBuffer(MAX_PATH), -1,
                          olePath, MAX_PATH);

      m_strInitDir.ReleaseBuffer (-1);
      //
      // Convert the path to an ITEMIDLIST.
      //
      hr = pDesktopFolder->ParseDisplayName(NULL,
                                            NULL,
                                            olePath,
                                            &chEaten,
                                            &pidl,
                                            &dwAttributes);
      if (FAILED(hr))
      {
        pMalloc ->Free (pidl);
        pMalloc ->Release ();
        return 0;
      }
      bInfo.pidlRoot = pidl;

    }
  }
  bInfo.hwndOwner = oWner;
  bInfo.pszDisplayName = m_strPath.GetBuffer (MAX_PATH);
  CString strOpen;
  strOpen.LoadString(IDS_STRING107);
  //bInfo.lpszTitle = (m_strTitle.IsEmpty()) ? "Open":m_strTitle;//# Localizable string#
  bInfo.lpszTitle = (m_strTitle.IsEmpty()) ? strOpen:m_strTitle;
  bInfo.ulFlags = BIF_RETURNFSANCESTORS|BIF_RETURNONLYFSDIRS|BIF_DONTGOBELOWDOMAIN;
  bInfo.lpfn = BrowseCtrlCallback;  // address of callback function
  bInfo.lParam = (LPARAM)this;      // pass address of object to callback function

  if ((pidl = ::SHBrowseForFolder(&bInfo)) == NULL)
  {
    return 0;
  }
  m_strPath.ReleaseBuffer();
  m_iImageIndex = bInfo.iImage;

  if (::SHGetPathFromIDList(pidl,m_strPath.GetBuffer(MAX_PATH)) == FALSE)
  {
    pMalloc ->Free(pidl);
    pMalloc ->Release();
    return 0;
  }

  m_strPath.ReleaseBuffer();

  pMalloc ->Free(pidl);
  pMalloc ->Release();

  return 1;
}


Examples - C++ Insert Symbol Tool - dirdialog.H

dirdialog.H

C++ Insert Symbol Tool Example

////////////////////////////////////////////////////////////////////////
// DirDialog.h: interface for the CDirDialog class.
//
//////////////////////////////////////////////////////////////////////

#if !defined(AFX_DIRDIALOG_H__62FFAC92_1DEE_11D1_B87A_0060979CDF6D__INCLUDED_)
#define AFX_DIRDIALOG_H__62FFAC92_1DEE_11D1_B87A_0060979CDF6D__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000

class CDirDialog
{
  public:
    CDirDialog();
    virtual ~CDirDialog();
    int DoBrowse(HWND oWner);

    CString m_strPath;
    CString m_strInitDir;
    CString m_strSelDir;
    CString m_strTitle;
    int  m_iImageIndex;
};

#endif // !defined(AFX_DIRDIALOG_H__62FFAC92_1DEE_11D1_B87A_0060979CDF6D__INCLUDED_)


Examples - C++ Insert Symbol Tool - InsSymb.cpp

InsSymb.cpp

C++ Insert Symbol Tool Example

// InsSymb.cpp : Implementation of CInsSymb
#include "stdafx.h"
#include "InsTool.h"
#include "InsSymb.h"
#include "TDialog.h"

/////////////////////////////////////////////////////////////////////////////
//const IID IID_Tool = {0x6A48112C,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
//const IID IID_IApplication = {0x6A481101,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

// CInsSymb

STDMETHODIMP CInsSymb::InterfaceSupportsErrorInfo(REFIID riid)
{
    static const IID* arr[] =
    {
        &IID_ITurboCADTool,
    };
    for (int i=0;i<sizeof(arr)/sizeof(arr[0]);i++)
    {
        if (InlineIsEqualGUID(*arr[i],riid))
            return S_OK;
    }
    return S_FALSE;
}

STDMETHODIMP CInsSymb::get_ClassID(BSTR* retval)
{
    HRESULT hRes = E_FAIL;
    LPOLESTR olestr = NULL;

    try
    {
        *retval = NULL;

        hRes = ::StringFromCLSID(CLSID_InsSymb, &olestr);
        CHECK_HRESULT(hRes)

        *retval = ::SysAllocString(olestr);

        hRes = S_OK;
    }
    catch (...)
    {

        TRACE_EXCEPTION("CInsSymb::get_ClassID")
        _clearfp();
    }

    if (olestr != NULL)
        CoTaskMemFree(olestr);

    return hRes;
}

STDMETHODIMP CInsSymb::get_Description( BSTR* retval)
{
    HRESULT hRes = E_FAIL;
    CString strResult;

    try
    {
        *retval = NULL;

        //CString strResult="Insert Symbol Tools"; //# Localizable string#
        CString strResult;
        strResult.LoadString(IDS_DESCRIPTION);
        *retval =  strResult.AllocSysString();
        hRes = S_OK;
    }
    catch (...)
    {
        TRACE_EXCEPTION("CInsSymb::get_Description")
        _clearfp();
    }
    return hRes;
}

/* ITurboCADTool methods: */
STDMETHODIMP CInsSymb::GetToolInfo(VARIANT FAR* CommandNames,
                                   VARIANT FAR* MenuCaptions,
                                   VARIANT FAR* StatusPrompts,
                                   VARIANT FAR* ToolTips,
                                   VARIANT FAR* Enabled,
                                   VARIANT FAR* WantsUpdates,
                                   long FAR* retval)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());

    HRESULT hRes = E_FAIL;

    SAFEARRAYBOUND bound = {NUM_TOOLS, 0};

    CString cstrText;
    CString cstrTextTemp;

    BSTR bstrCommandName = NULL;
    BSTR bstrMenuCaption = NULL;
    BSTR bstrStatusPrompt = NULL;
    BSTR bstrToolTip = NULL;

    BOOL bEnabled = TRUE;
    BOOL bWantsUpdates = TRUE;

    long lIndicies = 0;
    try
    {

        hRes = SafeArrayRedim(CommandNames->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(MenuCaptions->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(StatusPrompts->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(ToolTips->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(Enabled->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(WantsUpdates->parray, &bound);
        CHECK_HRESULT(hRes)

        //CString cstrText="SDK|Insert_Symbol"; //# Localizable string#
        cstrText.LoadString (IDS_MAINMENU);
        cstrText.Insert(cstrText.GetLength (), '|');
        cstrTextTemp.LoadString (IDS_SUBMENU);
        cstrText.Insert(cstrText.GetLength (), cstrTextTemp);
        cstrText.Insert(cstrText.GetLength (), '|');
        cstrTextTemp.LoadString (IDS_MENUCAPTION);
        cstrText.Insert(cstrText.GetLength (), cstrTextTemp);
        cstrTextTemp.Empty ();

        bstrCommandName = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(CommandNames->parray, &lIndicies, (void *)bstrCommandName);
        CHECK_HRESULT(hRes)

        cstrText.Empty ();
        cstrText.LoadString (IDS_MENUCAPTION);
        bstrMenuCaption = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(MenuCaptions->parray, &lIndicies, (void *)bstrMenuCaption);
        CHECK_HRESULT(hRes)

        cstrText.Empty ();
         cstrText.LoadString (IDS_PROMT);
        bstrStatusPrompt = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(StatusPrompts->parray, &lIndicies, (void *)bstrStatusPrompt);
        CHECK_HRESULT(hRes)

        //cstrText="SDKInsertSymbol"; //# Localizable string#
        cstrText.LoadString (IDS_TOOLTIPS);;
        bstrToolTip = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(ToolTips->parray, &lIndicies, (void *)bstrToolTip);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayPutElement(Enabled->parray, &lIndicies, (void *)&bEnabled);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayPutElement(WantsUpdates->parray, &lIndicies, (void *)&bWantsUpdates);
        CHECK_HRESULT(hRes)

        *retval = NUM_TOOLS;
    }
    catch (...)
    {
        if (SUCCEEDED(hRes))
            hRes = E_FAIL;
        TRACE_EXCEPTION("CInsSymb::GetToolInfo")
        _clearfp();
    }
    return hRes;
}

STDMETHODIMP CInsSymb::CopyBitmap( VARIANT_BOOL LargeButtons, VARIANT_BOOL Monochrome, VARIANT_BOOL FAR* retval)
{
    HRESULT hRes = E_FAIL;
    try
    {
        CHECK_HRESULT(hRes)
        hRes = S_OK;
    }
    catch (...)
    {
        TRACE_EXCEPTION("CInsSymb::CopyBitmap")
        _clearfp();
    }
    return hRes;
}

STDMETHODIMP CInsSymb::GetPicture( VARIANT_BOOL LargeButtons, VARIANT_BOOL Monochrome, IDispatch** retval)
{
    HRESULT hRes = E_FAIL;
    try
    {
        CHECK_HRESULT(hRes)
        hRes = S_OK;
    }
    catch (...)
    {
        TRACE_EXCEPTION("CAALBTool::GetPicture")
        _clearfp();
    }
    return hRes;
}

STDMETHODIMP CInsSymb::Run( IDispatch* ThisTool, VARIANT_BOOL FAR* retval)
{
    CWnd *pMainWnd = AfxGetMainWnd();

    AFX_MANAGE_STATE(AfxGetStaticModuleState());

    CInsToolApp *pApp = (CInsToolApp *)AfxGetApp();

    HRESULT hRes = E_FAIL;

    Tool *pThisTool = NULL;
    IApplication *pIApp = NULL;

    IGraphic *pIGr = NULL;
    Graphics *pGrs = NULL;

    IDrawing *pIDwg = NULL;

    Views *pVis = NULL;
    View  *pVi = NULL;

    PickResult *pPickRes=NULL;
    PickEntry *pPickEnt=NULL;

    RegenMethods *pRegMets=NULL;
    RegenMethod *pIRegMet=NULL;

    COleVariant varAperture(0.2);
    COleVariant varItem;
    long lItem = 0;
    long lIndex = 0;

    COleVariant varOptional(varMissing);
    COleVariant varType((const long)imsiPolyline);

    VARIANT_BOOL	varCopy = FALSE;
    VARIANT_BOOL	varRetval = FALSE;

    long lID = 0;

    BSTR bstrType = NULL;
    CString	strType;

    BSTR bstrDescription=NULL;
    CString strDescription;

    BSTR bstrName=NULL;
    CString strName;

    HCURSOR hOC = ::SetCursor(::LoadCursor(NULL,IDC_WAIT));

    try
    {

        hRes = ThisTool->QueryInterface(IID_Tool, (void **)&pThisTool);
        CHECK_HRESULT(hRes)

        hRes = pThisTool->get_Application(&pIApp);
        CHECK_HRESULT(hRes)
/*
        hRes = pIApp->get_ActiveDrawing(&pIDwg);
        CHECK_HRESULT(hRes)

        hRes = pIDwg->get_Graphics(&pGrs);
        CHECK_HRESULT(hRes)

        hRes = pIDwg->get_Views(&pVis);
        CHECK_HRESULT(hRes)

        varItem = 0L;
        hRes = pVis->get_Item(&varItem,&pVi);
        CHECK_HRESULT(hRes)

         hRes = pIApp->get_RegenMethods(&pRegMets);
        CHECK_HRESULT(hRes)
*/

        CTDialog *pdlg = new CTDialog(this, pMainWnd, pThisTool);
        pdlg->Create(CTDialog::IDD, NULL /*pMainWnd*/);

        VARIANT_BOOL	varRetval1 = false;

        hRes = UpdateToolStatus(ThisTool, &varRetval1, &varRetval1, &varRetval1);
        CHECK_HRESULT(hRes)

        pThisTool->Release();
        pThisTool = NULL;

//		hRes = pVi->Refresh();
        hRes = S_OK;
    }
    catch (...)
    {
        TRACE_EXCEPTION("CInsSymb::Run")
        _clearfp();
    }

//	RELEASE(pIGr)
//	RELEASE(pGrs)
//	RELEASE(pIDwg)
//	RELEASE(pVis)
//	RELEASE(pVi)

    RELEASE(pThisTool)
    RELEASE(pIApp)
    ::SetCursor(hOC);

    return hRes;
}

STDMETHODIMP CInsSymb::UpdateToolStatus(IDispatch* ThisTool, VARIANT_BOOL FAR* Enabled, VARIANT_BOOL FAR* Checked, VARIANT_BOOL FAR* retval)
{
    HRESULT hRes = E_FAIL;

    try
    {
        if(m_bRunned == TRUE)
        {
            (*Enabled) = false;
        }
        *retval = TRUE;
        hRes = S_OK;

    }
    catch (...)
    {
        TRACE_EXCEPTION("CInsSymb::UpdateToolStatus")
        _clearfp();
    }

    return hRes;
}

STDMETHODIMP CInsSymb::Initialize( IDispatch * ThisTool, VARIANT_BOOL FAR* retval)
{
    HRESULT hRes = E_FAIL;
    try
    {
        m_pTCState = AfxGetModuleState();
        *retval = TRUE;
        hRes = S_OK;
    }
    catch (...)
    {
        TRACE_EXCEPTION("CInsSymb::Initialize")
        _clearfp();
    }
    return hRes;
}


Examples - C++ Insert Symbol Tool - InsSymb.h

InsSymb.h

C++ Insert Symbol Tool Example

// InsSymb.h : Declaration of the CInsSymb

#ifndef __INSSYMB_H_
#define __INSSYMB_H_

#include "resource.h"       // main symbols

/////////////////////////////////////////////////////////////////////////////
// CInsSymb
class ATL_NO_VTABLE CInsSymb :
    public CComObjectRootEx<CComSingleThreadModel>,
    public CComCoClass<CInsSymb, &CLSID_InsSymb>,
    public ISupportErrorInfo,
//	public IDispatchImpl<IInsSymb, &IID_IInsSymb, &LIBID_INSTOOLLib>
    public CComDualImpl<ITurboCADTool, &IID_ITurboCADTool, &LIBID_INSTOOLLib, TYPELIB_MAJOR, TYPELIB_MINOR>
{
public:
    CInsSymb()
    {
        m_bRunned = false;
    }

DECLARE_REGISTRY_RESOURCEID(IDR_INSSYMB)
DECLARE_CLASSFACTORY_SINGLETON(CInsSymb)

BEGIN_COM_MAP(CInsSymb)
//	COM_INTERFACE_ENTRY(IInsSymb)
    COM_INTERFACE_ENTRY(ITurboCADTool)
    COM_INTERFACE_ENTRY(IDispatch)
    COM_INTERFACE_ENTRY(ISupportErrorInfo)
END_COM_MAP()

// ISupportsErrorInfo
    STDMETHOD(InterfaceSupportsErrorInfo)(REFIID riid);

// IInsSymb
public:
    BOOL m_bRunned;
    AFX_MODULE_STATE* m_pTCState;
    /* ITurboCADTool properties: */
    STDMETHOD(get_ClassID)(THIS_ BSTR* retval);
    STDMETHOD(get_Description)(THIS_ BSTR* retval);

    /* ITurboCADTool methods: */
    STDMETHOD(GetToolInfo)(THIS_ VARIANT FAR* CommandNames, VARIANT FAR* MenuCaptions, VARIANT FAR* StatusPrompts, VARIANT FAR* ToolTips, VARIANT FAR* Enabled, VARIANT FAR* WantsUpdates, long FAR* retval);
    STDMETHOD(CopyBitmap)(THIS_ VARIANT_BOOL LargeButtons, VARIANT_BOOL Monochrome, VARIANT_BOOL FAR* retval);
    STDMETHOD(GetPicture)(THIS_ VARIANT_BOOL LargeButtons, VARIANT_BOOL Monochrome, IDispatch** retval);
    STDMETHOD(Run)(THIS_ IDispatch* ThisTool, VARIANT_BOOL FAR* retval);
    STDMETHOD(UpdateToolStatus)(THIS_ IDispatch* ThisTool, VARIANT_BOOL FAR* Enabled, VARIANT_BOOL FAR* Checked, VARIANT_BOOL FAR* retval);
    STDMETHOD(Initialize)(THIS_ IDispatch * ThisTool, VARIANT_BOOL FAR* retval);

protected:
};

#endif //__INSSYMB_H_


Examples - C++ Insert Symbol Tool - InsTool.cpp

InsTool.cpp

C++ Insert Symbol Tool Example

// InsTool.cpp : Implementation of DLL Exports.

// Note: Proxy/Stub Information
//		To build a separate proxy/stub DLL,
//		run nmake -f InsToolps.mk in the project directory.

#include "stdafx.h"
#include "resource.h"
#include "initguid.h"
#include "InsTool.h"

#include "InsTool_i.c"
#include "InsSymb.h"

COleVariant varMissing((long)DISP_E_PARAMNOTFOUND, VT_ERROR);
COleVariant varTrue(1L);
COleVariant varFalse(0L);

CComModule _Module;

BEGIN_OBJECT_MAP(ObjectMap)
    OBJECT_ENTRY(CLSID_InsSymb, CInsSymb)
END_OBJECT_MAP()

CInsToolApp theApp;

BOOL CInsToolApp::InitInstance()
{
    _Module.Init(ObjectMap, m_hInstance);
    return CWinApp::InitInstance();
}

int CInsToolApp::ExitInstance()
{
    _Module.Term();
    return CWinApp::ExitInstance();
}

/////////////////////////////////////////////////////////////////////////////
// Used to determine whether the DLL can be unloaded by OLE

STDAPI DllCanUnloadNow(void)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    return (AfxDllCanUnloadNow()==S_OK && _Module.GetLockCount()==0) ? S_OK : S_FALSE;
}

/////////////////////////////////////////////////////////////////////////////
// Returns a class factory to create an object of the requested type

STDAPI DllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID* ppv)
{
    return _Module.GetClassObject(rclsid, riid, ppv);
}

/////////////////////////////////////////////////////////////////////////////
// DllRegisterServer - Adds entries to the system registry

STDAPI DllRegisterServer(void)
{
    // registers object, typelib and all interfaces in typelib
    return _Module.RegisterServer(TRUE);
}

/////////////////////////////////////////////////////////////////////////////
// DllUnregisterServer - Removes entries from the system registry

STDAPI DllUnregisterServer(void)
{
    _Module.UnregisterServer();
    return S_OK;
}


Examples - C++ Insert Symbol Tool - InsTool.h

InsTool.h

C++ Insert Symbol Tool Example

/* this ALWAYS GENERATED file contains the definitions for the interfaces */

/* File created by MIDL compiler version 5.01.0164 */
/* at Wed Jun 14 18:15:41 2000
 */
/* Compiler settings for InsTool.idl:
    Oicf (OptLev=i2), W1, Zp8, env=Win32, ms_ext, c_ext
    error checks: allocation ref bounds_check enum stub_data
*/
//@@MIDL_FILE_HEADING(  )

/* verify that the <rpcndr.h> version is high enough to compile this file*/
#ifndef __REQUIRED_RPCNDR_H_VERSION__
#define __REQUIRED_RPCNDR_H_VERSION__ 440
#endif

#include "rpc.h"
#include "rpcndr.h"

#ifndef __RPCNDR_H_VERSION__
#error this stub requires an updated version of <rpcndr.h>
#endif // __RPCNDR_H_VERSION__

#ifndef COM_NO_WINDOWS_H
#include "windows.h"
#include "ole2.h"
#endif /*COM_NO_WINDOWS_H*/

#ifndef __InsTool_h__
#define __InsTool_h__

#ifdef __cplusplus
extern "C"{
#endif

/* Forward Declarations */

#ifndef __ITurboCADTool_FWD_DEFINED__
#define __ITurboCADTool_FWD_DEFINED__
typedef interface ITurboCADTool ITurboCADTool;
#endif 	/* __ITurboCADTool_FWD_DEFINED__ */

#ifndef __IInsSymb_FWD_DEFINED__
#define __IInsSymb_FWD_DEFINED__
typedef interface IInsSymb IInsSymb;
#endif 	/* __IInsSymb_FWD_DEFINED__ */

#ifndef __InsSymb_FWD_DEFINED__
#define __InsSymb_FWD_DEFINED__

#ifdef __cplusplus
typedef class InsSymb InsSymb;
#else
typedef struct InsSymb InsSymb;
#endif /* __cplusplus */

#endif 	/* __InsSymb_FWD_DEFINED__ */

/* header files for imported files */
#include "oaidl.h"
#include "ocidl.h"

void __RPC_FAR * __RPC_USER MIDL_user_allocate(size_t);
void __RPC_USER MIDL_user_free( void __RPC_FAR * );

#ifndef __ITurboCADTool_INTERFACE_DEFINED__
#define __ITurboCADTool_INTERFACE_DEFINED__

/* interface ITurboCADTool */
/* [object][uuid] */

EXTERN_C const IID IID_ITurboCADTool;

#if defined(__cplusplus) && !defined(CINTERFACE)

    MIDL_INTERFACE("6A481304-E531-11CF-A115-00A024158DAF")
    ITurboCADTool : public IDispatch
    {
    public:
        virtual /* [propget] */ HRESULT __stdcall get_ClassID(
            /* [retval][out] */ BSTR __RPC_FAR *ret) = 0;

        virtual /* [propget] */ HRESULT __stdcall get_Description(
            /* [retval][out] */ BSTR __RPC_FAR *ret) = 0;

        virtual HRESULT __stdcall GetToolInfo(
            /* [out][in] */ VARIANT __RPC_FAR *CommandNames,
            /* [out][in] */ VARIANT __RPC_FAR *MenuCaptions,
            /* [out][in] */ VARIANT __RPC_FAR *StatusPrompts,
            /* [out][in] */ VARIANT __RPC_FAR *ToolTips,
            /* [out][in] */ VARIANT __RPC_FAR *Enabled,
            /* [out][in] */ VARIANT __RPC_FAR *WantsUpdates,
            /* [retval][out] */ long __RPC_FAR *ret) = 0;

        virtual HRESULT __stdcall CopyBitmap(
            /* [in] */ VARIANT_BOOL LargeButtons,
            /* [in] */ VARIANT_BOOL Monochrome,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual HRESULT __stdcall GetPicture(
            /* [in] */ VARIANT_BOOL LargeButtons,
            /* [in] */ VARIANT_BOOL Monochrome,
            /* [retval][out] */ IDispatch __RPC_FAR *__RPC_FAR *ret) = 0;

        virtual HRESULT __stdcall Run(
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual HRESULT __stdcall UpdateToolStatus(
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Enabled,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Checked,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual HRESULT __stdcall Initialize(
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

    };

#else 	/* C style interface */

    typedef struct ITurboCADToolVtbl
    {
        BEGIN_INTERFACE

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *QueryInterface )(
            ITurboCADTool __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [iid_is][out] */ void __RPC_FAR *__RPC_FAR *ppvObject);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *AddRef )(
            ITurboCADTool __RPC_FAR * This);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *Release )(
            ITurboCADTool __RPC_FAR * This);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetTypeInfoCount )(
            ITurboCADTool __RPC_FAR * This,
            /* [out] */ UINT __RPC_FAR *pctinfo);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetTypeInfo )(
            ITurboCADTool __RPC_FAR * This,
            /* [in] */ UINT iTInfo,
            /* [in] */ LCID lcid,
            /* [out] */ ITypeInfo __RPC_FAR *__RPC_FAR *ppTInfo);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetIDsOfNames )(
            ITurboCADTool __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [size_is][in] */ LPOLESTR __RPC_FAR *rgszNames,
            /* [in] */ UINT cNames,
            /* [in] */ LCID lcid,
            /* [size_is][out] */ DISPID __RPC_FAR *rgDispId);

        /* [local] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Invoke )(
            ITurboCADTool __RPC_FAR * This,
            /* [in] */ DISPID dispIdMember,
            /* [in] */ REFIID riid,
            /* [in] */ LCID lcid,
            /* [in] */ WORD wFlags,
            /* [out][in] */ DISPPARAMS __RPC_FAR *pDispParams,
            /* [out] */ VARIANT __RPC_FAR *pVarResult,
            /* [out] */ EXCEPINFO __RPC_FAR *pExcepInfo,
            /* [out] */ UINT __RPC_FAR *puArgErr);

        /* [propget] */ HRESULT ( __stdcall __RPC_FAR *get_ClassID )(
            ITurboCADTool __RPC_FAR * This,
            /* [retval][out] */ BSTR __RPC_FAR *ret);

        /* [propget] */ HRESULT ( __stdcall __RPC_FAR *get_Description )(
            ITurboCADTool __RPC_FAR * This,
            /* [retval][out] */ BSTR __RPC_FAR *ret);

        HRESULT ( __stdcall __RPC_FAR *GetToolInfo )(
            ITurboCADTool __RPC_FAR * This,
            /* [out][in] */ VARIANT __RPC_FAR *CommandNames,
            /* [out][in] */ VARIANT __RPC_FAR *MenuCaptions,
            /* [out][in] */ VARIANT __RPC_FAR *StatusPrompts,
            /* [out][in] */ VARIANT __RPC_FAR *ToolTips,
            /* [out][in] */ VARIANT __RPC_FAR *Enabled,
            /* [out][in] */ VARIANT __RPC_FAR *WantsUpdates,
            /* [retval][out] */ long __RPC_FAR *ret);

        HRESULT ( __stdcall __RPC_FAR *CopyBitmap )(
            ITurboCADTool __RPC_FAR * This,
            /* [in] */ VARIANT_BOOL LargeButtons,
            /* [in] */ VARIANT_BOOL Monochrome,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        HRESULT ( __stdcall __RPC_FAR *GetPicture )(
            ITurboCADTool __RPC_FAR * This,
            /* [in] */ VARIANT_BOOL LargeButtons,
            /* [in] */ VARIANT_BOOL Monochrome,
            /* [retval][out] */ IDispatch __RPC_FAR *__RPC_FAR *ret);

        HRESULT ( __stdcall __RPC_FAR *Run )(
            ITurboCADTool __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        HRESULT ( __stdcall __RPC_FAR *UpdateToolStatus )(
            ITurboCADTool __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Enabled,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Checked,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        HRESULT ( __stdcall __RPC_FAR *Initialize )(
            ITurboCADTool __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        END_INTERFACE
    } ITurboCADToolVtbl;

    interface ITurboCADTool
    {
        CONST_VTBL struct ITurboCADToolVtbl __RPC_FAR *lpVtbl;
    };

#ifdef COBJMACROS

#define ITurboCADTool_QueryInterface(This,riid,ppvObject)	\
    (This)->lpVtbl -> QueryInterface(This,riid,ppvObject)

#define ITurboCADTool_AddRef(This)	\
    (This)->lpVtbl -> AddRef(This)

#define ITurboCADTool_Release(This)	\
    (This)->lpVtbl -> Release(This)

#define ITurboCADTool_GetTypeInfoCount(This,pctinfo)	\
    (This)->lpVtbl -> GetTypeInfoCount(This,pctinfo)

#define ITurboCADTool_GetTypeInfo(This,iTInfo,lcid,ppTInfo)	\
    (This)->lpVtbl -> GetTypeInfo(This,iTInfo,lcid,ppTInfo)

#define ITurboCADTool_GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)	\
    (This)->lpVtbl -> GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)

#define ITurboCADTool_Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)	\
    (This)->lpVtbl -> Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)

#define ITurboCADTool_get_ClassID(This,ret)	\
    (This)->lpVtbl -> get_ClassID(This,ret)

#define ITurboCADTool_get_Description(This,ret)	\
    (This)->lpVtbl -> get_Description(This,ret)

#define ITurboCADTool_GetToolInfo(This,CommandNames,MenuCaptions,StatusPrompts,ToolTips,Enabled,WantsUpdates,ret)	\
    (This)->lpVtbl -> GetToolInfo(This,CommandNames,MenuCaptions,StatusPrompts,ToolTips,Enabled,WantsUpdates,ret)

#define ITurboCADTool_CopyBitmap(This,LargeButtons,Monochrome,ret)	\
    (This)->lpVtbl -> CopyBitmap(This,LargeButtons,Monochrome,ret)

#define ITurboCADTool_GetPicture(This,LargeButtons,Monochrome,ret)	\
    (This)->lpVtbl -> GetPicture(This,LargeButtons,Monochrome,ret)

#define ITurboCADTool_Run(This,ThisTool,ret)	\
    (This)->lpVtbl -> Run(This,ThisTool,ret)

#define ITurboCADTool_UpdateToolStatus(This,ThisTool,Enabled,Checked,ret)	\
    (This)->lpVtbl -> UpdateToolStatus(This,ThisTool,Enabled,Checked,ret)

#define ITurboCADTool_Initialize(This,ThisTool,ret)	\
    (This)->lpVtbl -> Initialize(This,ThisTool,ret)

#endif /* COBJMACROS */

#endif 	/* C style interface */

/* [propget] */ HRESULT __stdcall ITurboCADTool_get_ClassID_Proxy(
    ITurboCADTool __RPC_FAR * This,
    /* [retval][out] */ BSTR __RPC_FAR *ret);

void __RPC_STUB ITurboCADTool_get_ClassID_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [propget] */ HRESULT __stdcall ITurboCADTool_get_Description_Proxy(
    ITurboCADTool __RPC_FAR * This,
    /* [retval][out] */ BSTR __RPC_FAR *ret);

void __RPC_STUB ITurboCADTool_get_Description_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITurboCADTool_GetToolInfo_Proxy(
    ITurboCADTool __RPC_FAR * This,
    /* [out][in] */ VARIANT __RPC_FAR *CommandNames,
    /* [out][in] */ VARIANT __RPC_FAR *MenuCaptions,
    /* [out][in] */ VARIANT __RPC_FAR *StatusPrompts,
    /* [out][in] */ VARIANT __RPC_FAR *ToolTips,
    /* [out][in] */ VARIANT __RPC_FAR *Enabled,
    /* [out][in] */ VARIANT __RPC_FAR *WantsUpdates,
    /* [retval][out] */ long __RPC_FAR *ret);

void __RPC_STUB ITurboCADTool_GetToolInfo_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITurboCADTool_CopyBitmap_Proxy(
    ITurboCADTool __RPC_FAR * This,
    /* [in] */ VARIANT_BOOL LargeButtons,
    /* [in] */ VARIANT_BOOL Monochrome,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB ITurboCADTool_CopyBitmap_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITurboCADTool_GetPicture_Proxy(
    ITurboCADTool __RPC_FAR * This,
    /* [in] */ VARIANT_BOOL LargeButtons,
    /* [in] */ VARIANT_BOOL Monochrome,
    /* [retval][out] */ IDispatch __RPC_FAR *__RPC_FAR *ret);

void __RPC_STUB ITurboCADTool_GetPicture_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITurboCADTool_Run_Proxy(
    ITurboCADTool __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *ThisTool,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB ITurboCADTool_Run_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITurboCADTool_UpdateToolStatus_Proxy(
    ITurboCADTool __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *ThisTool,
    /* [out][in] */ VARIANT_BOOL __RPC_FAR *Enabled,
    /* [out][in] */ VARIANT_BOOL __RPC_FAR *Checked,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB ITurboCADTool_UpdateToolStatus_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITurboCADTool_Initialize_Proxy(
    ITurboCADTool __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *ThisTool,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB ITurboCADTool_Initialize_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

#endif 	/* __ITurboCADTool_INTERFACE_DEFINED__ */

#ifndef __INSTOOLLib_LIBRARY_DEFINED__
#define __INSTOOLLib_LIBRARY_DEFINED__

/* library INSTOOLLib */
/* [helpstring][version][uuid] */

EXTERN_C const IID LIBID_INSTOOLLib;

EXTERN_C const CLSID CLSID_InsSymb;

#ifdef __cplusplus

class DECLSPEC_UUID("EFFDB231-8367-11D2-82F5-006052012837")
InsSymb;
#endif
#endif /* __INSTOOLLib_LIBRARY_DEFINED__ */

/* Additional Prototypes for ALL interfaces */

unsigned long             __RPC_USER  BSTR_UserSize(     unsigned long __RPC_FAR *, unsigned long            , BSTR __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  BSTR_UserMarshal(  unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, BSTR __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  BSTR_UserUnmarshal(unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, BSTR __RPC_FAR * );
void                      __RPC_USER  BSTR_UserFree(     unsigned long __RPC_FAR *, BSTR __RPC_FAR * );

unsigned long             __RPC_USER  VARIANT_UserSize(     unsigned long __RPC_FAR *, unsigned long            , VARIANT __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  VARIANT_UserMarshal(  unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, VARIANT __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  VARIANT_UserUnmarshal(unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, VARIANT __RPC_FAR * );
void                      __RPC_USER  VARIANT_UserFree(     unsigned long __RPC_FAR *, VARIANT __RPC_FAR * );

/* end of Additional Prototypes */

#ifdef __cplusplus
}
#endif

#endif


Examples - C++ Insert Symbol Tool - Merge.cpp

Merge.cpp

C++ Insert Symbol Tool Example

// Merge.cpp: implementation of the CMerge class.
//
//////////////////////////////////////////////////////////////////////

#include "stdafx.h"
#include "InsTool.h"
#include "InsSymb.h"
#include "TDialog.h"

#ifdef _DEBUG
#undef THIS_FILE
static char THIS_FILE[]=__FILE__;
#define new DEBUG_NEW
#endif
//const IID IID_IGraphic = {0x6A481109, 0xE531, 0x11CF, {0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

template <class IStyles, class IStyle> HRESULT StylesMerge(IStyles *pISrc, IStyles *pITrg, CMerge* pMerge)
{
    HRESULT hr = E_FAIL;
    BSTR bstrName = NULL;
    COleVariant varItem;
    long lCnt = 0;
    long lItem = 0;
    IStyle* pIStyle = NULL;

    try
    {
        hr = pISrc->get_Count(&lCnt);
        CHECK_HRESULT(hr);

        for (lItem = 0; lItem < lCnt; lItem++)
        {
            varItem = lItem;
            hr = pISrc->get_Item(&varItem, &pIStyle);
            CHECK_HRESULT(hr);

//			hr = pIStyle->get_Name(&bstrName);
//			CHECK_HRESULT(hr);

//			pIStyle->Release();
//			pIStyle = NULL;

//			varItem = bstrName;
//			hr = pITrg->get_Item(&varItem, &pIStyle);
//			if (FAILED(hr))
//			{
//				if (pMerge != NULL)
            hr = pMerge->StyleMerge(pIStyle);
//			}
            CHECK_HRESULT(hr);

            ::SysFreeString(bstrName);
            bstrName = NULL;

            pIStyle->Release();
            pIStyle = NULL;
        }
        hr = S_OK;
    }
    catch (...)
    {
//		_clearfp();

    }

    _clearfp();

    if (bstrName != NULL)
        ::SysFreeString(bstrName);

    if (pIStyle != NULL)
        pIStyle->Release();

    return hr;
}

void CMapStyles::CleanAll()
{
    long lInd = 0;
    Style *pStyle = NULL;
    POSITION pos = GetStartPosition();
    while (pos != NULL)
    {
        GetNextAssoc(pos, lInd, pStyle);
        if (pStyle != NULL)
            pStyle->Release();
    }
    RemoveAll();
}

void CMapLineStyles::CleanAll()
{
    long lInd = 0;
    LineStyle *pLineStyle = NULL;
    POSITION pos = GetStartPosition();
    while (pos != NULL)
    {
        GetNextAssoc(pos, lInd, pLineStyle);
        if (pLineStyle != NULL)
            pLineStyle->Release();
    }
    RemoveAll();
}

void CMapBrushStyles::CleanAll()
{
    long lInd = 0;
    BrushStyle *pBrushStyle = NULL;
    POSITION pos = GetStartPosition();
    while (pos != NULL)
    {
        GetNextAssoc(pos, lInd, pBrushStyle);
        if (pBrushStyle != NULL)
            pBrushStyle->Release();
    }
    RemoveAll();
}

void CMapBlocks::CleanAll()
{
    long lInd = 0;
    Block *pBlock = NULL;
    POSITION pos = GetStartPosition();
    while (pos != NULL)
    {
        GetNextAssoc(pos, lInd, pBlock);
        if (pBlock != NULL)
            pBlock->Release();
    }
    RemoveAll();
}

void CMapLayers::CleanAll()
{
    long lInd = 0;
    Layer *pLayer = NULL;
    POSITION pos = GetStartPosition();
    while (pos != NULL)
    {
        GetNextAssoc(pos, lInd, pLayer);
        if (pLayer != NULL)
            pLayer->Release();
    }
    RemoveAll();
}

void CArrBlock::CleanAll()
{
    int lCount = GetSize();
    Block *pBlock = NULL;
    for (int iInd = 0; iInd < lCount; iInd++)
    {
        pBlock = GetAt(iInd);
        if (pBlock != NULL)
            pBlock->Release();
    }
}

void CArrLayer::CleanAll()
{
    int lCount = GetSize();
    Layer *pLayer = NULL;
    for (int iInd = 0; iInd < lCount; iInd++)
    {
        pLayer = GetAt(iInd);
        if (pLayer != NULL)
            pLayer->Release();
    }
}

//////////////////////////////////////////////////////////////////////
// Construction/Destruction
//////////////////////////////////////////////////////////////////////

CMerge::CMerge() :
m_bInit(FALSE),
m_pIDwgSrc(NULL),
m_pStylesSrc(NULL),
m_pLineStylesSrc(NULL),
m_pBrushStylesSrc(NULL),
m_pBlksSrc(NULL),
m_pGrsSrc(NULL),
m_pSelSrc(NULL),
m_pIDwgTrg(NULL),
m_pStylesTrg(NULL),
m_pLineStylesTrg(NULL),
m_pBrushStylesTrg(NULL),
m_pBlksTrg(NULL),
m_pGrsTrg(NULL),
m_pIGrMerge(NULL),
m_pLayersSrc(NULL),
m_pLayersTrg(NULL)
{
}

CMerge::~CMerge()
{
    CleanAll();
}

void CMerge::CleanAll()
{

    RELEASE(m_pStylesSrc)
    RELEASE(m_pLineStylesSrc)
    RELEASE(m_pBrushStylesSrc)
    RELEASE(m_pBlksSrc)
    RELEASE(m_pGrsSrc)
    RELEASE(m_pSelSrc)
    RELEASE(m_pLayersSrc)

    RELEASE(m_pIDwgSrc)

    RELEASE(m_pStylesTrg)
    RELEASE(m_pLineStylesTrg)
    RELEASE(m_pBrushStylesTrg)
    RELEASE(m_pBlksTrg)
    RELEASE(m_pGrsTrg)
    RELEASE(m_pLayersTrg)

    RELEASE(m_pIDwgTrg)

    RELEASE(m_pIGrMerge)

    m_bInit = FALSE;

}

HRESULT CMerge::Init(IDrawing *pIDwgSrc, IDrawing *pIDwgTrg, BOOL bSel)
{
    HRESULT hRes = E_FAIL;
    COleVariant varType((const long)imsiGroup);
    if (pIDwgSrc == NULL
        || pIDwgTrg == NULL)
        return hRes;

    if (m_bInit)
        CleanAll();
        HMODULE	hDBAPI = NULL;
        hDBAPI = GetModuleHandle(DBAPI70);
        if (hDBAPI == NULL)
        {
            hDBAPI = GetModuleHandle(DBAPI60);

            if (hDBAPI == NULL)
            {
                hDBAPI = GetModuleHandle(DBAPI50);
            }
        }

    m_pfnDwgGetGraphic = (DRAWINGGETGRAPHIC)GetProcAddress(hDBAPI, _T("DrawingGetPaperRoot"));
    if (m_pfnDwgGetGraphic == NULL)
        return hRes;

    m_pfnGrGetDispatch = (GRAPHICGETDISPATCH)GetProcAddress(hDBAPI, _T("GraphicGetDispatch"));
    if (m_pfnGrGetDispatch == NULL)
        return hRes;

    try
    {
        m_pIDwgSrc = pIDwgSrc;
        m_pIDwgSrc->AddRef();

        hRes = m_pIDwgSrc->get_Styles(&m_pStylesSrc);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgSrc->get_LineStyles(&m_pLineStylesSrc);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgSrc->get_BrushStyles(&m_pBrushStylesSrc);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgSrc->get_Blocks(&m_pBlksSrc);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgSrc->get_Layers(&m_pLayersSrc);
        CHECK_HRESULT(hRes)

        m_bSel = bSel;
        if (m_bSel)
            hRes = m_pIDwgSrc->get_Selection(&m_pSelSrc);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgSrc->get_Graphics(&m_pGrsSrc);
        CHECK_HRESULT(hRes)

        m_pIDwgTrg = pIDwgTrg;
        m_pIDwgTrg->AddRef();

        hRes = m_pIDwgTrg->get_Styles(&m_pStylesTrg);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgTrg->get_LineStyles(&m_pLineStylesTrg);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgTrg->get_BrushStyles(&m_pBrushStylesTrg);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgTrg->get_Blocks(&m_pBlksTrg);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgTrg->get_Layers(&m_pLayersTrg);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgTrg->get_Graphics(&m_pGrsTrg);
        CHECK_HRESULT(hRes)

        hRes = m_pGrsTrg->Add(&varType,
                              &varMissing,
                              &varMissing,
                              &varMissing,
                              &varMissing,
                              &varMissing,
                              &m_pIGrMerge);

/*
        hRes = m_pGrsTrg->Add(&varMissing,
                              &varMissing,
                              &varMissing,
                              &varMissing,
                              &varMissing,
                              &varMissing,
                              &m_pIGrMerge);
*/
        CHECK_HRESULT(hRes)

        m_pGrsTrg->Release();
        m_pGrsTrg = NULL;

        hRes = m_pIGrMerge->get_Graphics(&m_pGrsTrg);
        CHECK_HRESULT(hRes)

        m_bInit = TRUE;
        hRes = S_OK;
    }
    catch (...)
    {
        CleanAll();
        _clearfp();
    }

    return hRes;
}

HRESULT CMerge::InitA(IDrawing *pIDwgSrc, IDrawing *pIDwgTrg)
{
    HRESULT hRes = E_FAIL;
    if (pIDwgSrc == NULL
        || pIDwgTrg == NULL)
        return hRes;

///	if (m_bInit)
///		CleanAll();

    HMODULE hDBAPI = NULL;//GetModuleHandle(DBAPI);
    hDBAPI = GetModuleHandle(DBAPI70);
    if (hDBAPI == NULL)
    {
        hDBAPI = GetModuleHandle(DBAPI60);
        if (hDBAPI == NULL)
        {
            hDBAPI = GetModuleHandle(DBAPI50);
        }
    }

    m_pfnDwgGetGraphic = (DRAWINGGETGRAPHIC)GetProcAddress(hDBAPI, _T("DrawingGetPaperRoot"));
    if (m_pfnDwgGetGraphic == NULL)
        return hRes;

    m_pfnGrGetDispatch = (GRAPHICGETDISPATCH)GetProcAddress(hDBAPI, _T("GraphicGetDispatch"));
    if (m_pfnGrGetDispatch == NULL)
        return hRes;

    try
    {
        m_pIDwgSrc = pIDwgSrc;
        m_pIDwgSrc->AddRef();

        hRes = m_pIDwgSrc->get_Styles(&m_pStylesSrc);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgSrc->get_LineStyles(&m_pLineStylesSrc);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgSrc->get_BrushStyles(&m_pBrushStylesSrc);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgSrc->get_Blocks(&m_pBlksSrc);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgSrc->get_Layers(&m_pLayersSrc);
        CHECK_HRESULT(hRes)

        m_pIDwgTrg = pIDwgTrg;
        m_pIDwgTrg->AddRef();

        hRes = m_pIDwgTrg->get_Styles(&m_pStylesTrg);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgTrg->get_LineStyles(&m_pLineStylesTrg);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgTrg->get_BrushStyles(&m_pBrushStylesTrg);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgTrg->get_Blocks(&m_pBlksTrg);
        CHECK_HRESULT(hRes)

        hRes = m_pIDwgTrg->get_Layers(&m_pLayersTrg);
        CHECK_HRESULT(hRes)

//		m_pGrsTrg->Release();
//		m_pGrsTrg = NULL;

        m_bInit = TRUE;
        hRes = S_OK;
    }
    catch (...)
    {
        CleanAll();
        _clearfp();
    }

    return hRes;
}

HRESULT CMerge::Run(IGraphic **ppIGrMerge, BOOL bGrsOnly)
{
    HRESULT hRes = E_FAIL;
    if (!m_bInit)
        return hRes;

    *ppIGrMerge = NULL;

    Graphics *pGrsSrc = NULL;
    Graphics *pGrsTrg = NULL;

    try
    {
        if (!bGrsOnly)
        {
            hRes = MergeStyles();
            CHECK_HRESULT(hRes)

            hRes = MergeLineStyles();
            CHECK_HRESULT(hRes)

            hRes = MergeBrushStyles();
            CHECK_HRESULT(hRes)

            hRes = MergeLayers();
            CHECK_HRESULT(hRes)

            hRes = MergeBlocks();
            CHECK_HRESULT(hRes)
        }
        if (!m_bSel)
            hRes = MergeGraphics(m_pGrsSrc, m_pGrsTrg);
        else
            hRes = MergeSelGraphics();
        CHECK_HRESULT(hRes)

        hRes = CorrectGraphic(m_pIGrMerge);
        CHECK_HRESULT(hRes)

    }
    catch (...)
    {
        m_pIGrMerge->Delete();
        m_pIGrMerge = NULL;

        CleanAddedBlocks();
        CleanAddedLayers();
        _clearfp();
    }

    if (ppIGrMerge != NULL
        && m_pIGrMerge != NULL)
    {
        *ppIGrMerge = m_pIGrMerge;
        (*ppIGrMerge)->AddRef();
    }
    return hRes;
}

HRESULT CMerge::RunA() // merge only styles, blocks, layers (not gaphics).
{
    HRESULT hRes = E_FAIL;
    if (!m_bInit)
        return hRes;

    try
    {
        hRes = MergeStyles();
        CHECK_HRESULT(hRes)

        hRes = MergeLineStyles();
        CHECK_HRESULT(hRes)

        hRes = MergeBrushStyles();
        CHECK_HRESULT(hRes)

        hRes = MergeLayers();
        CHECK_HRESULT(hRes)

        hRes = MergeBlocks();
        CHECK_HRESULT(hRes)
    }
    catch (...)
    {
        CleanAddedBlocks();
        CleanAddedLayers();
        _clearfp();
    }

    return hRes;
}

HRESULT CMerge::StyleMerge(IUnknown *pIUnkStyle)
{
    HRESULT hRes = E_FAIL;
    Style *pStyle = NULL;
    LineStyle *pLineStyle = NULL;
    BrushStyle *pBrushStyle = NULL;

    try
    {
        hRes = pIUnkStyle->QueryInterface(IID_Style, (void**)&pStyle);
        if (SUCCEEDED(hRes))
        {
            hRes = MergeStyle(pStyle);
            CHECK_HRESULT(hRes)
        }

        if (FAILED(hRes))
        {
            hRes = pIUnkStyle->QueryInterface(IID_LineStyle, (void**)&pLineStyle);
            if (SUCCEEDED(hRes))
            {
                hRes = MergeLineStyle(pLineStyle);
                CHECK_HRESULT(hRes)
            }
        }

        if (FAILED(hRes))
        {
            hRes = pIUnkStyle->QueryInterface(IID_BrushStyle, (void**)&pBrushStyle);
            if (SUCCEEDED(hRes))
            {
                hRes = MergeBrushStyle(pBrushStyle);
                CHECK_HRESULT(hRes)
            }
        }
    }
    catch (...)
    {
        _clearfp();
    }

    if (pStyle != NULL)
        pStyle->Release();

    if (pLineStyle != NULL)
        pLineStyle->Release();

    if (pBrushStyle != NULL)
        pBrushStyle->Release();

    return hRes;
}

HRESULT CMerge::MergeStyle(Style *pStSrc)
{
    HRESULT hRes = E_FAIL;

    BSTR bstrName = NULL;
    CComVariant varItem;
    Style *pStTrg = NULL;

    try
    {
        hRes = pStSrc->get_Name(&bstrName);
        CHECK_HRESULT(hRes);

        varItem = bstrName;
        hRes = m_pStylesTrg->get_Item(&varItem, &pStTrg);

    }
    catch (...)
    {
        _clearfp();
    }

    if (pStTrg != NULL)
        pStTrg->Release();
    return hRes;
}

HRESULT CMerge::MergeStyles()
{
    HRESULT hRes = E_FAIL;
    if (!m_bInit)
        return hRes;

    try
    {
        hRes = StylesMerge<Styles, Style>(m_pStylesSrc, m_pStylesTrg, this);
    }
    catch (...)
    {
        _clearfp();
    }

    return hRes;
}

HRESULT CMerge::MergeLineStyle(LineStyle *pLineStSrc)
{
    HRESULT hRes = E_FAIL;

    CComVariant varItem;
    CComVariant varDashes;
    CComVariant varDescription;

    BSTR bstrName = NULL;
    CString cstrDescription(_T("Added brushstyle"));//# Non-localizable string#
    BSTR bstrDescription = cstrDescription.AllocSysString();

    LineStyle *pLineStTrg = NULL;
    long lIndex = 0;

    try
    {
        hRes = pLineStSrc->get_Name(&bstrName);
        CHECK_HRESULT(hRes);

        varItem = bstrName;
        hRes = m_pLineStylesTrg->get_Item(&varItem, &pLineStTrg);

        if (FAILED(hRes))
        {
            hRes = pLineStSrc->GetDashes(&varDashes);
            CHECK_HRESULT(hRes);

//			hRes = pLineStSrc->get_Description(&bstrDescription);
//			CHECK_HRESULT(hRes);

            varDescription = bstrDescription;

            hRes = m_pLineStylesTrg->Add(bstrName, &varDashes, &varDescription, &pLineStTrg);
            CHECK_HRESULT(hRes);
        }

        hRes = pLineStSrc->get_Index(&lIndex);
        CHECK_HRESULT(hRes);

        m_mapLineStyles.SetAt(lIndex, pLineStTrg);
        pLineStTrg->AddRef();
    }
    catch (...)
    {
        _clearfp();
    }

    if (pLineStTrg != NULL)
        pLineStTrg->Release();

    if (bstrDescription != NULL)
        ::SysFreeString(bstrDescription);
    return hRes;
}

HRESULT CMerge::MergeLineStyles()
{
    HRESULT hRes = E_FAIL;
    if (!m_bInit)
        return hRes;

    try
    {
        hRes = StylesMerge<LineStyles, LineStyle>(m_pLineStylesSrc, m_pLineStylesTrg, this);
        hRes = S_OK;
    }
    catch (...)
    {
        _clearfp();
    }

    return hRes;
}

HRESULT CMerge::MergeBrushStyles()
{
    HRESULT hRes = E_FAIL;
    if (!m_bInit)
        return hRes;

    try
    {
        hRes = StylesMerge<BrushStyles, BrushStyle>(m_pBrushStylesSrc, m_pBrushStylesTrg, this);
    }
    catch (...)
    {
        _clearfp();
    }

    return hRes;
}

HRESULT CMerge::MergeBrushStyle(BrushStyle *pBrStSrc)
{
    HRESULT hRes = E_FAIL;

    BSTR bstrName = NULL;
    CComVariant varItem;
    BrushStyle *pBrStTrg = NULL;
    long lIndex = 0;
    try
    {
        hRes = pBrStSrc->get_Name(&bstrName);
        CHECK_HRESULT(hRes);

        varItem = bstrName;
        hRes = m_pBrushStylesTrg->get_Item(&varItem, &pBrStTrg);
        if (SUCCEEDED(hRes))
        {
            hRes = pBrStSrc->get_Index(&lIndex);
            m_mapBrushStyles.SetAt(lIndex, pBrStTrg);
            pBrStTrg->AddRef();
        }
        hRes = S_OK;
    }
    catch (...)
    {
        _clearfp();
    }

    if (pBrStTrg != NULL)
        pBrStTrg->Release();
    return hRes;
}

HRESULT CMerge::MergeLayer(Layer *pLyrSrc, Layer** ppLyrTrg)
{
    HRESULT hRes = E_FAIL;
    if (!m_bInit)
        return hRes;

    BSTR bstrName = NULL;
    COleVariant varName;

    long lIndex = 0;
    COleVariant varIndex;

    COleVariant varVisible(varMissing);
    COleVariant varEditable(varMissing);
    COleVariant varFrozen(varMissing);
    COleVariant varColor(varMissing);
    COleVariant varZOrder(varMissing);

    IMSI_COLOR color = 0;
    IMSI_BOOL bEditable = TRUE;
    IMSI_BOOL bFrozen = FALSE;
    IMSI_BOOL bVisible = TRUE;
    long lZOrder = 0;

    COleVariant varLineStyle(varMissing);
    COleVariant varBrushStyle(varMissing);
    COleVariant varStyle(varMissing);

    BrushStyle* pBrushStyle = NULL;
    LineStyle* pLineStyle = NULL;
    Style* pStyle = NULL;

    try
    {
        hRes = pLyrSrc->get_Name(&bstrName);
        CHECK_HRESULT(hRes)

        varName = bstrName;
        hRes = m_pLayersTrg->get_Item(&varName, ppLyrTrg);
        if (FAILED(hRes))
        {
            // TODO: these methods are not implemented yet
//			hRes = pLyrSrc->get_BrushStyle(&pBrushStyle);
//			CHECK_HRESULT(hRes)

//			hRes = pBrushStyle->get_Index(&lIndex);
//			pBrushStyle->Release();
//			pBrushStyle = NULL;
//			if (m_mapBrushStyles.Lookup(lIndex, pBrushStyle))
//			{
//				varBrushStyle.vt = VT_DISPATCH;
//				varBrushStyle.pdispVal = (IDispatch *)pBrushStyle;
//				pBrushStyle->AddRef();
//			}

//			hRes = pLyrSrc->get_Style(&pStyle);
//			CHECK_HRESULT(hRes)

//			hRes = pStyle->get_Index(&lIndex);
//			pStyle->Release();
//			pStyle = NULL;
//			if (m_mapStyles.Lookup(lIndex, pStyle))
//			{
//				varStyle.vt = VT_DISPATCH;
//				varStyle.pdispVal = (IDispatch *)pStyle;
//				pStyle->AddRef();
//			}

            hRes = pLyrSrc->get_LineStyle(&pLineStyle);
            CHECK_HRESULT(hRes)

            hRes = pLineStyle->get_Index(&lIndex);
            pLineStyle->Release();
            pLineStyle = NULL;
            if (m_mapLineStyles.Lookup(lIndex, pLineStyle))
            {
                varLineStyle.vt = VT_DISPATCH;
                varLineStyle.pdispVal = (IDispatch *)pLineStyle;
                pLineStyle->AddRef();
            }

            hRes = pLyrSrc->get_Color(&color);
            CHECK_HRESULT(hRes)
            varColor = color;

            hRes = pLyrSrc->get_Editable(&bEditable);
            CHECK_HRESULT(hRes)
            varEditable.vt = VT_BOOL;
            varEditable.bVal = bEditable;

            hRes = pLyrSrc->get_Frozen(&bFrozen);
            CHECK_HRESULT(hRes)
            varFrozen.vt = VT_BOOL;
            varFrozen.bVal = bFrozen;

            hRes = pLyrSrc->get_Visible(&bVisible);
            CHECK_HRESULT(hRes)
            varVisible.vt = VT_BOOL;
            varVisible.bVal = bVisible;

            hRes = pLyrSrc->get_ZOrder(&lZOrder);
            CHECK_HRESULT(hRes)
            varZOrder = lZOrder;

            hRes = m_pLayersTrg->Add(bstrName,
                                     &varVisible,
                                     &varEditable,
                                     &varFrozen,
                                     &varColor,
                                     &varLineStyle,
                                     &varBrushStyle,
                                     &varStyle,
                                      &varZOrder,
                                     ppLyrTrg);
            CHECK_HRESULT(hRes)

            m_arrLyrs.Add((*ppLyrTrg));
            (*ppLyrTrg)->AddRef();
        }

        hRes = S_OK;
    }
    catch (...)
    {
        _clearfp();
    }

    if (bstrName != NULL)
        ::SysFreeString(bstrName);

    if (pBrushStyle != NULL)
        pBrushStyle->Release();

//	if (pLineStyle != NULL)
//		pLineStyle->Release();

    if (pStyle != NULL)
        pStyle->Release();

    return hRes;
}

HRESULT CMerge::MergeLayers()
{
    HRESULT hRes = E_FAIL;
    if (!m_bInit)
        return hRes;

    Layer *pLyrSrc = NULL;
    Layer *pLyrTrg = NULL;

    try
    {
        long lCount = 0;
        hRes = m_pLayersSrc->get_Count(&lCount);
        CHECK_HRESULT(hRes)

        long lItem = 0;
        COleVariant varItem(lItem);
        for (lItem = 0; lItem < lCount; lItem++)
        {
            varItem = lItem;
            hRes = m_pLayersSrc->get_Item(&varItem, &pLyrSrc);
            CHECK_HRESULT(hRes)

            hRes = MergeLayer(pLyrSrc, &pLyrTrg);
            CHECK_HRESULT(hRes)

            m_mapLayers.SetAt(lItem, pLyrTrg);
            pLyrTrg = NULL;

            pLyrSrc->Release();
            pLyrSrc = NULL;
        }

        hRes = S_OK;
    }
    catch (...)
    {
        _clearfp();
    }

    if (pLyrSrc != NULL)
        pLyrSrc->Release();

    if (pLyrTrg != NULL)
        pLyrTrg->Release();

    return hRes;
}

HRESULT CMerge::MergeBlock(Block *pBlkSrc, Block** ppBlkTrg)
{
    HRESULT hRes = E_FAIL;
    if (!m_bInit)
        return hRes;

    BSTR bstrName = NULL;
    COleVariant varName;

    IVertex *pIVrt = NULL;

    IDispatch *pIDisp = NULL;
    Graphics *pGrsSrc = NULL;
    IGraphic *pIGrSrc = NULL;

//	COleVariant varX(varMissing);
//	COleVariant varY(varMissing);
//	COleVariant varZ(varMissing);
    COleVariant varX(0L);
    COleVariant varY(0L);
    COleVariant varZ(0L);

    long lIndex = 0;
    COleVariant varIndex;

    IGraphic *pIGrTrg = NULL;

    try
    {
        hRes = pBlkSrc->get_Name(&bstrName);
        CHECK_HRESULT(hRes)

        varName = bstrName;
        hRes = m_pBlksTrg->get_Item(&varName, ppBlkTrg);
        if (FAILED(hRes))
        {
            hRes = pBlkSrc->get_Anchor(&pIVrt);
            if (SUCCEEDED(hRes))
            {
                double x = 0;
                hRes = pIVrt->get_X(&x);
                CHECK_HRESULT(hRes)
                varX = x;

                double y = 0;
                hRes = pIVrt->get_Y(&y);
                CHECK_HRESULT(hRes)
                varY = y;

                double z = 0;
                hRes = pIVrt->get_Z(&z);
                CHECK_HRESULT(hRes)
                varZ = z;
            }

            hRes = pBlkSrc->get_Graphics(&pGrsSrc);
            CHECK_HRESULT(hRes)

            hRes = pGrsSrc->get_Parent(&pIDisp);
            CHECK_HRESULT(hRes)

            hRes = pIDisp->QueryInterface(IID_IGraphic, (void**)&pIGrSrc);
            CHECK_HRESULT(hRes)

            hRes = pIGrSrc->Duplicate(&pIGrTrg);
            CHECK_HRESULT(hRes)

            hRes = m_pGrsTrg->AddGraphic(pIGrTrg, &varMissing, &varMissing);
            CHECK_HRESULT(hRes)

            hRes = CorrectGraphic(pIGrTrg, FALSE);
            CHECK_HRESULT(hRes)

            hRes = m_pBlksTrg->Add(bstrName,
                                   pIGrTrg,
                                   &varX,
                                   &varY,
                                   &varZ,
                                   &varFalse,
                                   &varFalse,
                                   NULL,
                                   ppBlkTrg);
            CHECK_HRESULT(hRes)

            hRes = pIGrTrg->Delete();
            CHECK_HRESULT(hRes)

            m_arrBlks.Add((*ppBlkTrg));
            (*ppBlkTrg)->AddRef();
        }

        hRes = S_OK;
    }
    catch (...)
    {
        _clearfp();
    }

    if (bstrName != NULL)
        ::SysFreeString(bstrName);

    if (pIVrt != NULL)
        pIVrt->Release();

    if (pGrsSrc != NULL)
        pGrsSrc->Release();

    if (pIGrSrc != NULL)
        pIGrSrc->Release();

    if (pIDisp != NULL)
        pIDisp->Release();

    if (pIGrTrg != NULL)
        pIGrTrg->Release();

    return hRes;
}

HRESULT CMerge::MergeBlocks()
{
    HRESULT hRes = E_FAIL;
    if (!m_bInit)
        return hRes;

    Properties *pProps = NULL;
    Property *pProp = NULL;

    CString cstrProp(_T("TileMode"));//# Non-localizable string#
    COleVariant varProp(cstrProp);
    COleVariant varValOld;
///	varValOld.vt = VT_I2;

    COleVariant varValMS;
    varValMS.vt = VT_I2;
    varValMS.iVal = 1;
    COleVariant varValPS;
    varValPS.vt = VT_I2;
    varValPS.iVal = 0;
    IDispatch *pIGrRoot = NULL;

    Block *pBlkSrc = NULL;
    Block *pBlkTrg = NULL;

    Graphics *pGrs = NULL;
    pGrs = m_pGrsTrg;

    try
    {
        hRes = m_pIDwgTrg->get_Properties(&pProps);
        CHECK_HRESULT(hRes)

        hRes = pProps->get_Item(&varProp, &pProp);
        CHECK_HRESULT(hRes)

        hRes = pProp->get_Value(0, &varValOld);
        CHECK_HRESULT(hRes)

//		varValPS.ChangeType(varValOld.vt);
        if (varValOld == varValPS)
        {
            long lDwg = 0;
            hRes = m_pIDwgTrg->get__Handle(&lDwg);
            CHECK_HRESULT(hRes)

            long lRoot = (*m_pfnDwgGetGraphic)(lDwg);
            if (lRoot == 0)
                throw E_FAIL;

            pIGrRoot = (*m_pfnGrGetDispatch)(lRoot, NULL);
            if (pIGrRoot == 0)
                throw E_FAIL;

            hRes = pProp->put_Value(0, &varValMS);
            CHECK_HRESULT(hRes)

        }

        hRes = m_pIDwgTrg->get_Graphics(&m_pGrsTrg);
        CHECK_HRESULT(hRes)

        long lCount = 0;
        hRes = m_pBlksSrc->get_Count(&lCount);
        CHECK_HRESULT(hRes)

        long lItem = 0;
        COleVariant varItem(lItem);
        for (lItem = 0; lItem < lCount; lItem++)
        {
            varItem = lItem;
            hRes = m_pBlksSrc->get_Item(&varItem, &pBlkSrc);
            CHECK_HRESULT(hRes)

            hRes = MergeBlock(pBlkSrc, &pBlkTrg);
            CHECK_HRESULT(hRes)

            m_mapBlks.SetAt(lItem, pBlkTrg);
            pBlkTrg = NULL;

            pBlkSrc->Release();
            pBlkSrc = NULL;
        }

        hRes = CorrectAddedBlocks();
        CHECK_HRESULT(hRes);

        if (varValOld == varValPS)
        {
            hRes = pProp->put_Value(0, &varValOld);
            CHECK_HRESULT(hRes);

            m_pGrsTrg->Release();
            m_pGrsTrg = NULL;

            hRes = m_pIDwgTrg->get_Graphics(&m_pGrsTrg); // it is need to call DrawingUpdateCurrentRoot
            CHECK_HRESULT(hRes);
        }

        hRes = S_OK;
    }
    catch (...)
    {
        TRACE_EXCEPTION("CMerge::MergeBlocks")
        _clearfp();

    }

    if (pIGrRoot != NULL)
        pIGrRoot->Release();

    if (m_pGrsTrg != NULL)
        m_pGrsTrg->Release();

    m_pGrsTrg = pGrs;

    if (pProp != NULL)
        pProp->Release();

    if (pProps != NULL)
        pProps->Release();

    if (pBlkSrc != NULL)
        pBlkSrc->Release();

    if (pBlkTrg != NULL)
        pBlkTrg->Release();

    return hRes;
}

HRESULT CMerge::MergeSelGraphics()
{
    HRESULT hRes = E_FAIL;
    if (!m_bInit)
        return hRes;

    IGraphic *pIGrSrc = NULL;
    IGraphic *pIGrTrg = NULL;

    long lCount = 0;
    long lItem = 0;
    COleVariant varItem(lItem);

    long lInd = 0;
    COleVariant varInd(lInd);

    try
    {
        hRes = m_pSelSrc->get_Count(&lCount);
        CHECK_HRESULT(hRes)

        for (lItem = 0; lItem < lCount; lItem++)
        {
            varItem = lItem;
            hRes = m_pSelSrc->get_Item(&varItem, &pIGrSrc);
            CHECK_HRESULT(hRes)

            hRes = pIGrSrc->Duplicate(&pIGrTrg);
            CHECK_HRESULT(hRes)

            hRes = pIGrTrg->get_Index(&lInd);
            CHECK_HRESULT(hRes)

            hRes = pIGrTrg->Release();
            CHECK_HRESULT(hRes)

            pIGrTrg = NULL;

            varInd = lInd;
            hRes = m_pGrsSrc->Remove(&varInd, &pIGrTrg);
            CHECK_HRESULT(hRes)

            hRes = pIGrTrg->put_ID(0);
            CHECK_HRESULT(hRes)

            hRes = m_pGrsTrg->AddGraphic(pIGrTrg, &varMissing, &varMissing);
//			CHECK_HRESULT(hRes)

            pIGrTrg->Release();
            pIGrTrg = NULL;
        }
    }
    catch (...)
    {
        _clearfp();
    }

    if (pIGrSrc != NULL)
        pIGrSrc->Release();

    if (pIGrTrg != NULL)
        pIGrTrg->Release();
    return hRes;
}

HRESULT CMerge::MergeGraphics(Graphics *pGrsSrc, Graphics *pGrsTrg)
{
    HRESULT hRes = E_FAIL;
    if (!m_bInit)
        return hRes;

    IGraphic *pIGrSrc = NULL;
    IGraphic *pIGrTrg = NULL;

    long lCount = 0;
    long lItem = 0;
    COleVariant varItem(lItem);

    long lInd = 0;
    COleVariant varInd(lInd);

    try
    {
        hRes = m_pGrsSrc->get_Count(&lCount);
        CHECK_HRESULT(hRes)

        for (lItem = 0; lItem < lCount; lItem++)
        {
            varItem = lItem;
            hRes = m_pGrsSrc->get_Item(&varItem, &pIGrSrc);
            CHECK_HRESULT(hRes)
            ImsiGraphicType GrType;
//			unsigned short* GrType;
            hRes = pIGrSrc->get_TypeByValue(&GrType);
            CHECK_HRESULT(hRes)

            BSTR bstrGrType;
            hRes = pIGrSrc->get_Type(&bstrGrType);
            CHECK_HRESULT(hRes)
            CString cstrGrType;
            cstrGrType = bstrGrType;
            ::SysFreeString(bstrGrType);
            bstrGrType = NULL;

            if(	cstrGrType != "TCLight")//# Non-localizable string#
            {
                if (GrType != imsiViewport && GrType != imsiOleObject) // ViewPorts and OLE objects are excluded from merge
                {
                    hRes = pIGrSrc->Duplicate(&pIGrTrg);
                    CHECK_HRESULT(hRes)

    //				pIGrSrc->Release();
    //				pIGrSrc = NULL;

                    hRes = pIGrTrg->get_Index(&lInd);
                    CHECK_HRESULT(hRes)

                    hRes = pIGrTrg->Release();
                    CHECK_HRESULT(hRes)

                    pIGrTrg = NULL;

                    varInd = lInd;
                    hRes = m_pGrsSrc->Remove(&varInd, &pIGrTrg);
                    CHECK_HRESULT(hRes)

                    hRes = pIGrTrg->put_ID(0);
                    CHECK_HRESULT(hRes)

                    hRes = m_pGrsTrg->AddGraphic(pIGrTrg, &varMissing, &varMissing);
        //			CHECK_HRESULT(hRes)

                    pIGrTrg->Release();
                    pIGrTrg = NULL;
                }
            }
            pIGrSrc->Release();
            pIGrSrc = NULL;

        }
    }
    catch (...)
    {
        _clearfp();
    }

    if (pIGrSrc != NULL)
        pIGrSrc->Release();

    if (pIGrTrg != NULL)
        pIGrTrg->Release();

    return hRes;
}

HRESULT CMerge::CorrectAddedBlocks()
{
    HRESULT hRes = E_FAIL;
    if (!m_bInit)
        return hRes;

    hRes = S_OK;
    int iCount = m_arrBlks.GetSize();
    int iInd = 0;
    Block *pBlk = NULL;

    Graphics *pGrs = NULL;
    IDispatch *pIDisp = NULL;
    IGraphic *pIGr = NULL;

    for (iInd = 0; iInd < iCount; iInd++)
    {
        pBlk = m_arrBlks[iInd];
        if (pBlk != NULL)
        {
            try
            {
                hRes = pBlk->get_Graphics(&pGrs);
                CHECK_HRESULT(hRes)

                hRes = pGrs->get_Parent(&pIDisp);
                CHECK_HRESULT(hRes)

                hRes = pIDisp->QueryInterface(IID_IGraphic, (void **)&pIGr);
                CHECK_HRESULT(hRes)

                hRes = CorrectGraphic(pIGr);
                CHECK_HRESULT(hRes)
            }
            catch (...)
            {
                pBlk->Delete();
                pBlk->Release();
                m_arrBlks[iInd] = NULL;
            }

            if (pIDisp != NULL)
                pIDisp->Release();

            if (pGrs != NULL)
                pGrs->Release();

            if (pIGr != NULL)
                pIGr->Release();
        }
    }
    return hRes;
}

void CMerge::CleanAddedBlocks()
{
    if (!m_bInit)
        return ;

    try
    {

    }
    catch (...)
    {
        _clearfp();
    }
}

void CMerge::CleanAddedLayers()
{
    if (!m_bInit)
        return ;

    try
    {

    }
    catch (...)
    {
        _clearfp();
    }
}

HRESULT CMerge::CorrectGraphic(IGraphic * pIGr, BOOL bCorrectInserts)
{
    HRESULT hRes = E_FAIL;
    if (!m_bInit)
        return hRes;

    CString cstrType;
    BSTR bstrType = NULL;

    Block *pBlkSrc = NULL;
    Block *pBlkTrg = NULL;

    Layer *pLyr = NULL;
    long lIndex = 0;

    CString cstrDefLayer("0");
    BSTR bstrDefLayer = cstrDefLayer.AllocSysString();

    CString cstrDefLineSt("CONTINUOUS");//# Non-localizable string#
    BSTR bstrDefLineSt = cstrDefLineSt.AllocSysString();

    CString cstrDefBrushSt("SOLID");//# Non-localizable string#
    BSTR bstrDefBrushSt = cstrDefBrushSt.AllocSysString();

    COleVariant varLayer;
    COleVariant varLineSt;
    COleVariant varBrushSt;

    Graphics *pGrs = NULL;
    IGraphic *pIGrC = NULL;

    LineStyle *pLineSt = NULL;
    BrushStyle *pBrushSt = NULL;

    try
    {
        // TODO : to correct Styles, LineStyles, BrushStyles
        hRes = pIGr->get_Layer(&pLyr);
        if (SUCCEEDED(hRes))
        {
            hRes = pLyr->get_Index(&lIndex);
            CHECK_HRESULT(hRes)

            pLyr->Release();
            pLyr = NULL;

            if (m_mapLayers.Lookup(lIndex, pLyr))
            {
                varLayer.vt = VT_DISPATCH;
                varLayer.pdispVal = (IDispatch *)pLyr;
                pLyr->AddRef();
            }
            else
                varLayer = bstrDefLayer;

            hRes = pIGr->put_Layer(varLayer);
        }

        hRes = pIGr->get_LineStyle(&pLineSt);
        if (SUCCEEDED(hRes))
        {
            long lID = 0;
            hRes = pLineSt->get__TableEntryID(&lID);
            if (((short)lID) > 0)
            {
                hRes = pLineSt->get_Index(&lIndex);
                CHECK_HRESULT(hRes)

                pLineSt->Release();
                pLyr = NULL;

                if (m_mapLineStyles.Lookup(lIndex, pLineSt))
                {
                    varLineSt.vt = VT_DISPATCH;
                    varLineSt.pdispVal = (IDispatch *)pLineSt;
                    pLineSt->AddRef();
                }
                else
                    varLineSt = bstrDefLineSt;

                hRes = pIGr->put_LineStyle(varLineSt);
            }
        }

        hRes = pIGr->get_BrushStyle(&pBrushSt);
        if (SUCCEEDED(hRes))
        {
            long lID = 0;
            hRes = pBrushSt->get__TableEntryID(&lID);
            if (((short)lID) > 0)
            {
                hRes = pBrushSt->get_Index(&lIndex);
                if (SUCCEEDED(hRes))
                {
                    pBrushSt->Release();
                    pLyr = NULL;

                    if (m_mapBrushStyles.Lookup(lIndex, pBrushSt))
                    {
                        varLineSt.vt = VT_DISPATCH;
                        varLineSt.pdispVal = (IDispatch *)pBrushSt;
                        pBrushSt->AddRef();
                    }
                    else
                        varBrushSt = bstrDefBrushSt;
                }
                else
                    varBrushSt = bstrDefBrushSt;

                hRes = pIGr->put_BrushStyle(varBrushSt);
            }
        }

        hRes = pIGr->get_Type(&bstrType);
        CHECK_HRESULT(hRes)

        cstrType = bstrType;
        if (cstrType.CompareNoCase("Insert") == 0)//# Non-localizable string#
        {
            if (bCorrectInserts)
            {
                hRes = pIGr->get_Block(&pBlkSrc);
                CHECK_HRESULT(hRes)

                long lIndex = 0;
                hRes = pBlkSrc->get_Index(&lIndex);
                CHECK_HRESULT(hRes)

                if (m_mapBlks.Lookup(lIndex, pBlkTrg))
                {
                    hRes = pIGr->put_Block(pBlkTrg);
                    CHECK_HRESULT(hRes)
                }
            }
        }
        else
        {
            hRes = pIGr->get_Graphics(&pGrs);
            CHECK_HRESULT(hRes)

            long lCount = 0;
            long lItem = 0;
            COleVariant varItem(lItem);

            hRes = pGrs->get_Count(&lCount);
            CHECK_HRESULT(hRes)

            for (lItem = 0; lItem < lCount; lItem++)
            {
                varItem = lItem;
                hRes = pGrs->get_Item(&varItem, &pIGrC);
                CHECK_HRESULT(hRes)

                hRes = CorrectGraphic(pIGrC);
                CHECK_HRESULT(hRes)

                pIGrC->Release();
                pIGrC = NULL;
            }
        }
    }
    catch (...)
    {
        _clearfp();
    }

    varLayer.Clear();

    if (pBlkSrc != NULL)
        pBlkSrc->Release();

    if (pIGrC != NULL)
        pIGrC->Release();

    if (pGrs != NULL)
        pGrs->Release();

    return hRes;
}


Examples - C++ Insert Symbol Tool - Merge.h

Merge.h

C++ Insert Symbol Tool Example

// Merge.h: interface for the CMerge class.
//
//////////////////////////////////////////////////////////////////////

#if !defined(AFX_MERGE_H__AB417D73_CF7E_11D1_B818_000021452DB6__INCLUDED_)
#define AFX_MERGE_H__AB417D73_CF7E_11D1_B818_000021452DB6__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000

class CMapStyles : public CMap<long, long, Style*, Style*>
{
public:
    ~CMapStyles() {CleanAll();};
    void CleanAll();
};

class CMapLineStyles : public CMap<long, long, LineStyle*, LineStyle*>
{
public:
    ~CMapLineStyles() {CleanAll();};
    void CleanAll();
};
class CMapBrushStyles : public CMap<long, long, BrushStyle*, BrushStyle*>
{
public:
    ~CMapBrushStyles() {CleanAll();};
    void CleanAll();
};

class CMapBlocks : public CMap<long, long, Block*, Block*>
{
public:
    ~CMapBlocks() {CleanAll();};
    void CleanAll();
};

class CMapLayers : public CMap<long, long, Layer*, Layer*>
{
public:
    ~CMapLayers() {CleanAll();};
    void CleanAll();
};

class CArrBlock : public CArray<Block*, Block*>
{
public:
    ~CArrBlock() {CleanAll();};
    void CleanAll();
};

class CArrLayer : public CArray<Layer*, Layer*>
{
public:
    ~CArrLayer() {CleanAll();};
    void CleanAll();
};

class CMergeGraphic;
class CMerge
{
public:
    HRESULT CorrectGraphic(IGraphic *pIGr, BOOL bInsert = TRUE);

    void CleanAddedBlocks();
    HRESULT CorrectAddedBlocks();

    void CleanAddedLayers();

    virtual void CleanAll();
    CMerge();
    virtual ~CMerge();

    HRESULT Init(IDrawing *pIDwgSrc, IDrawing *pIDwgTrg, BOOL bSel);
    HRESULT InitA(IDrawing *pIDwgSrc, IDrawing *pIDwgTrg);

    HRESULT Run(IGraphic **ppIGrMerge, BOOL bGrsOnly = FALSE);
    HRESULT RunA();

    HRESULT StyleMerge(IUnknown *pIUnkStyle);

    CMapStyles m_mapStyles;
    CMapLineStyles m_mapLineStyles;
    CMapBrushStyles m_mapBrushStyles;
    CMapBlocks m_mapBlks;
    CMapLayers m_mapLayers;

    CArrBlock m_arrBlks;
    CArrLayer m_arrLyrs;
private:
    BOOL m_bSel;

    Selection* m_pSelSrc;
    IGraphic * m_pIGrMerge;
    BOOL m_bInit;

    IDrawing	*m_pIDwgSrc;
    Styles		*m_pStylesSrc;
    LineStyles	*m_pLineStylesSrc;
    BrushStyles	*m_pBrushStylesSrc;
    Blocks		*m_pBlksSrc;
    Layers		*m_pLayersSrc;
    Graphics	*m_pGrsSrc;

    IDrawing	*m_pIDwgTrg;
    Styles		*m_pStylesTrg;
    LineStyles	*m_pLineStylesTrg;
    BrushStyles	*m_pBrushStylesTrg;
    Blocks		*m_pBlksTrg;
    Layers		*m_pLayersTrg;
    Graphics	*m_pGrsTrg;

    HRESULT MergeStyles();
    HRESULT MergeStyle(Style *pStSrc);

    HRESULT MergeLineStyles();
    HRESULT MergeLineStyle(LineStyle *pLineStSrc);

    HRESULT MergeBrushStyles();
    HRESULT MergeBrushStyle(BrushStyle *pBrStSrc);

    HRESULT MergeBlock(Block *pBlkSrc, Block** ppBlkTrg);
    HRESULT MergeBlocks();

    HRESULT MergeLayer(Layer *pLyrSrc, Layer** ppLyrTrg);
    HRESULT MergeLayers();

    HRESULT MergeSelGraphics();
    HRESULT MergeGraphics(Graphics *pGrsSrc, Graphics *pGrsTrg);

    DRAWINGGETGRAPHIC m_pfnDwgGetGraphic;
    GRAPHICGETDISPATCH m_pfnGrGetDispatch;

    friend class CMergeGraphic;
};

#endif // !defined(AFX_MERGE_H__AB417D73_CF7E_11D1_B818_000021452DB6__INCLUDED_)


Examples - C++ Insert Symbol Tool - TCINTF.H

TCINTF.H

C++ Insert Symbol Tool Example

/* this ALWAYS GENERATED file contains the definitions for the interfaces */

/* File created by MIDL compiler version 3.01.75 */
/* at Thu Mar 12 13:59:03 1998
 */
/* Compiler settings for Tcintf.idl:
    Os (OptLev=s), W1, Zp8, env=Win32, ms_ext, c_ext
    error checks: none
*/
//@@MIDL_FILE_HEADING(  )
#include "rpc.h"
#include "rpcndr.h"
#ifndef COM_NO_WINDOWS_H
#include "windows.h"
#include "ole2.h"
#endif /*COM_NO_WINDOWS_H*/

#ifndef __Tcintf_h__
#define __Tcintf_h__

#ifdef __cplusplus
extern "C"{
#endif

/* Forward Declarations */

#ifndef __ITcApp_FWD_DEFINED__
#define __ITcApp_FWD_DEFINED__
typedef interface ITcApp ITcApp;
#endif 	/* __ITcApp_FWD_DEFINED__ */

#ifndef __ITcDrawing_FWD_DEFINED__
#define __ITcDrawing_FWD_DEFINED__
typedef interface ITcDrawing ITcDrawing;
#endif 	/* __ITcDrawing_FWD_DEFINED__ */

/* header files for imported files */
#include "oaidl.h"

void __RPC_FAR * __RPC_USER MIDL_user_allocate(size_t);
void __RPC_USER MIDL_user_free( void __RPC_FAR * );

/****************************************
 * Generated header for interface: __MIDL_itf_Tcintf_0000
 * at Thu Mar 12 13:59:03 1998
 * using MIDL 3.01.75
 ****************************************/
/* [local] */

#if 0
typedef void __RPC_FAR *hDrawing;

typedef void __RPC_FAR *hGraphic;

typedef void __RPC_FAR *hViewport;

typedef void __RPC_FAR *hExtents;

typedef void __RPC_FAR *hApp;

typedef void __RPC_FAR *hVertex;

typedef int CCommandBarInfo;

typedef void __RPC_FAR *LPMENUITEMINFO;

#endif
typedef struct PageSetupParams PageSetupParams;

extern RPC_IF_HANDLE __MIDL_itf_Tcintf_0000_v0_0_c_ifspec;
extern RPC_IF_HANDLE __MIDL_itf_Tcintf_0000_v0_0_s_ifspec;

#ifndef __ITcApp_INTERFACE_DEFINED__
#define __ITcApp_INTERFACE_DEFINED__

/****************************************
 * Generated header for interface: ITcApp
 * at Thu Mar 12 13:59:03 1998
 * using MIDL 3.01.75
 ****************************************/
/* [unique][helpstring][helpcontext][uuid][local][object] */

EXTERN_C const IID IID_ITcApp;

#if defined(__cplusplus) && !defined(CINTERFACE)

    interface DECLSPEC_UUID("6A481200-E531-11CF-A115-00A024158DAF")//# Non-localizable string#
    ITcApp : public IUnknown
    {
    public:
        virtual HRESULT __stdcall GetTcDrawing(
            hDrawing d,
            long nDrawing,
            ITcDrawing __RPC_FAR *__RPC_FAR *ppTcDrawing,
            BOOL Activate) = 0;

        virtual HRESULT __stdcall SetActiveDrawing(
            hDrawing d,
            ITcDrawing __RPC_FAR *__RPC_FAR *ppTcDrawing) = 0;

        virtual HRESULT __stdcall GetActiveDrawing(
            ITcDrawing __RPC_FAR *__RPC_FAR *ppTcDrawing) = 0;

        virtual HRESULT __stdcall AbortScript( void) = 0;

        virtual HRESULT __stdcall FileOpen(
            LPCTSTR pszPathName,
            ITcDrawing __RPC_FAR *__RPC_FAR *ppTcDrawing) = 0;

        virtual HRESULT __stdcall FileNew(
            LPCTSTR pszTemplate,
            ITcDrawing __RPC_FAR *__RPC_FAR *ppTcDrawing) = 0;

        virtual HRESULT __stdcall Exit( void) = 0;

        virtual HRESULT __stdcall DragNew(
            UINT nDraggerKind) = 0;

        virtual HRESULT __stdcall DragNextPointDown(
            UINT DraggerKind,
            LONG x,
            LONG y) = 0;

        virtual HRESULT __stdcall DragNextPointUp(
            UINT DraggerKind,
            LONG x,
            LONG y) = 0;

        virtual HRESULT __stdcall DragReset(
            UINT nFlags) = 0;

        virtual HRESULT __stdcall DragDraw(
            LONG x,
            LONG y) = 0;

        virtual HRESULT __stdcall DragLocalMenu(
            UINT nID) = 0;

        virtual HRESULT __stdcall DragLocalMenuIndex(
            int nItem) = 0;

        virtual HRESULT __stdcall DragGetLocalMenuSize(
            int nItem,
            UINT __RPC_FAR *pSize) = 0;

        virtual HRESULT __stdcall DragOnEnterKey(
            UINT __RPC_FAR *pResult) = 0;

        virtual HRESULT __stdcall DragOnCtrlEnterKey(
            UINT __RPC_FAR *pResult) = 0;

        virtual HRESULT __stdcall DragEditFieldChanged(
            int nField,
            LPCSTR str,
            UINT __RPC_FAR *pResult) = 0;

        virtual HRESULT __stdcall DragEditFieldLock(
            UINT nField) = 0;

        virtual HRESULT __stdcall DragEditFieldUnlock(
            UINT nField) = 0;

        virtual HRESULT __stdcall DragGetAddedGraphic(
            hGraphic __RPC_FAR *pg) = 0;

        virtual HRESULT __stdcall DragGetKind(
            UINT __RPC_FAR *pKind) = 0;

        virtual HRESULT __stdcall SetSnapMode(
            UINT nSnaps) = 0;

        virtual HRESULT __stdcall GetSnapMode(
            UINT __RPC_FAR *pSnaps) = 0;

        virtual HRESULT __stdcall SelectGraphic(
            hGraphic g,
            BOOL bAddToSel) = 0;

        virtual HRESULT __stdcall GetUserControl(
            BOOL __RPC_FAR *userControl) = 0;

        virtual HRESULT __stdcall SetUserControl(
            BOOL userControl) = 0;

        virtual HRESULT __stdcall GetVisible(
            BOOL __RPC_FAR *visible) = 0;

        virtual HRESULT __stdcall SetVisible(
            BOOL visible) = 0;

        virtual HRESULT __stdcall GetToolID(
            LPCTSTR name,
            UINT __RPC_FAR *pToolID) = 0;

        virtual HRESULT __stdcall RunTool(
            UINT nToolID) = 0;

        virtual HRESULT __stdcall ToolGetInt(
            int findex,
            int sindex,
            int WhichInt,
            long __RPC_FAR *prop) = 0;

        virtual HRESULT __stdcall ToolSetInt(
            int findex,
            int sindex,
            int WhichInt,
            long prop) = 0;

        virtual HRESULT __stdcall ToolGetString(
            int findex,
            int sindex,
            int WhichString,
            long lcid,
            BSTR __RPC_FAR *prop) = 0;

        virtual HRESULT __stdcall ToolSetString(
            int findex,
            int sindex,
            int WhichString,
            long lcid,
            BSTR prop) = 0;

        virtual HRESULT __stdcall ToolGetActive(
            int findex,
            int sindex,
            BOOL __RPC_FAR *prop) = 0;

        virtual HRESULT __stdcall ToolActivate(
            int findex,
            int sindex) = 0;

        virtual HRESULT __stdcall DoPick(
            int pickType,
            int __RPC_FAR *nAction,
            hDrawing __RPC_FAR *dPick,
            hViewport __RPC_FAR *vpPick,
            hExtents __RPC_FAR *ePick,
            long __RPC_FAR *snapModes) = 0;

        virtual HRESULT __stdcall GetCommandBarInfo(
            CCommandBarInfo __RPC_FAR *__RPC_FAR *ppRoot,
            BOOL __RPC_FAR *pbDirty) = 0;

        virtual HRESULT __stdcall ConnectEvents(
            IDispatch __RPC_FAR *EventSink,
            DWORD EventMask,
            long __RPC_FAR *ConnectionID) = 0;

        virtual HRESULT __stdcall DisconnectEvents(
            long ConnectionID) = 0;

        virtual HRESULT __stdcall QueryMenu(
            CCommandBarInfo __RPC_FAR *pItem,
            LPMENUITEMINFO lpmii) = 0;

        virtual HRESULT __stdcall ModifyMenu(
            short what,
            CCommandBarInfo __RPC_FAR *__RPC_FAR *ppItem,
            LPARAM lParam) = 0;

        virtual HRESULT __stdcall OnSelectionChange(
            BOOL bCreateSelector) = 0;

        virtual HRESULT __stdcall OpenCommandBarCfg(
            LPCTSTR pszFileName,
            long sections) = 0;

        virtual HRESULT __stdcall SaveCommandBarCfg(
            LPCTSTR pszFileName,
            long sections) = 0;

        virtual HRESULT __stdcall OnTurboLISP(
            BOOL bActivate) = 0;

    };

#else 	/* C style interface */

    typedef struct ITcAppVtbl
    {
        BEGIN_INTERFACE

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *QueryInterface )(
            ITcApp __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [iid_is][out] */ void __RPC_FAR *__RPC_FAR *ppvObject);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *AddRef )(
            ITcApp __RPC_FAR * This);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *Release )(
            ITcApp __RPC_FAR * This);

        HRESULT ( __stdcall __RPC_FAR *GetTcDrawing )(
            ITcApp __RPC_FAR * This,
            hDrawing d,
            long nDrawing,
            ITcDrawing __RPC_FAR *__RPC_FAR *ppTcDrawing,
            BOOL Activate);

        HRESULT ( __stdcall __RPC_FAR *SetActiveDrawing )(
            ITcApp __RPC_FAR * This,
            hDrawing d,
            ITcDrawing __RPC_FAR *__RPC_FAR *ppTcDrawing);

        HRESULT ( __stdcall __RPC_FAR *GetActiveDrawing )(
            ITcApp __RPC_FAR * This,
            ITcDrawing __RPC_FAR *__RPC_FAR *ppTcDrawing);

        HRESULT ( __stdcall __RPC_FAR *AbortScript )(
            ITcApp __RPC_FAR * This);

        HRESULT ( __stdcall __RPC_FAR *FileOpen )(
            ITcApp __RPC_FAR * This,
            LPCTSTR pszPathName,
            ITcDrawing __RPC_FAR *__RPC_FAR *ppTcDrawing);

        HRESULT ( __stdcall __RPC_FAR *FileNew )(
            ITcApp __RPC_FAR * This,
            LPCTSTR pszTemplate,
            ITcDrawing __RPC_FAR *__RPC_FAR *ppTcDrawing);

        HRESULT ( __stdcall __RPC_FAR *Exit )(
            ITcApp __RPC_FAR * This);

        HRESULT ( __stdcall __RPC_FAR *DragNew )(
            ITcApp __RPC_FAR * This,
            UINT nDraggerKind);

        HRESULT ( __stdcall __RPC_FAR *DragNextPointDown )(
            ITcApp __RPC_FAR * This,
            UINT DraggerKind,
            LONG x,
            LONG y);

        HRESULT ( __stdcall __RPC_FAR *DragNextPointUp )(
            ITcApp __RPC_FAR * This,
            UINT DraggerKind,
            LONG x,
            LONG y);

        HRESULT ( __stdcall __RPC_FAR *DragReset )(
            ITcApp __RPC_FAR * This,
            UINT nFlags);

        HRESULT ( __stdcall __RPC_FAR *DragDraw )(
            ITcApp __RPC_FAR * This,
            LONG x,
            LONG y);

        HRESULT ( __stdcall __RPC_FAR *DragLocalMenu )(
            ITcApp __RPC_FAR * This,
            UINT nID);

        HRESULT ( __stdcall __RPC_FAR *DragLocalMenuIndex )(
            ITcApp __RPC_FAR * This,
            int nItem);

        HRESULT ( __stdcall __RPC_FAR *DragGetLocalMenuSize )(
            ITcApp __RPC_FAR * This,
            int nItem,
            UINT __RPC_FAR *pSize);

        HRESULT ( __stdcall __RPC_FAR *DragOnEnterKey )(
            ITcApp __RPC_FAR * This,
            UINT __RPC_FAR *pResult);

        HRESULT ( __stdcall __RPC_FAR *DragOnCtrlEnterKey )(
            ITcApp __RPC_FAR * This,
            UINT __RPC_FAR *pResult);

        HRESULT ( __stdcall __RPC_FAR *DragEditFieldChanged )(
            ITcApp __RPC_FAR * This,
            int nField,
            LPCSTR str,
            UINT __RPC_FAR *pResult);

        HRESULT ( __stdcall __RPC_FAR *DragEditFieldLock )(
            ITcApp __RPC_FAR * This,
            UINT nField);

        HRESULT ( __stdcall __RPC_FAR *DragEditFieldUnlock )(
            ITcApp __RPC_FAR * This,
            UINT nField);

        HRESULT ( __stdcall __RPC_FAR *DragGetAddedGraphic )(
            ITcApp __RPC_FAR * This,
            hGraphic __RPC_FAR *pg);

        HRESULT ( __stdcall __RPC_FAR *DragGetKind )(
            ITcApp __RPC_FAR * This,
            UINT __RPC_FAR *pKind);

        HRESULT ( __stdcall __RPC_FAR *SetSnapMode )(
            ITcApp __RPC_FAR * This,
            UINT nSnaps);

        HRESULT ( __stdcall __RPC_FAR *GetSnapMode )(
            ITcApp __RPC_FAR * This,
            UINT __RPC_FAR *pSnaps);

        HRESULT ( __stdcall __RPC_FAR *SelectGraphic )(
            ITcApp __RPC_FAR * This,
            hGraphic g,
            BOOL bAddToSel);

        HRESULT ( __stdcall __RPC_FAR *GetUserControl )(
            ITcApp __RPC_FAR * This,
            BOOL __RPC_FAR *userControl);

        HRESULT ( __stdcall __RPC_FAR *SetUserControl )(
            ITcApp __RPC_FAR * This,
            BOOL userControl);

        HRESULT ( __stdcall __RPC_FAR *GetVisible )(
            ITcApp __RPC_FAR * This,
            BOOL __RPC_FAR *visible);

        HRESULT ( __stdcall __RPC_FAR *SetVisible )(
            ITcApp __RPC_FAR * This,
            BOOL visible);

        HRESULT ( __stdcall __RPC_FAR *GetToolID )(
            ITcApp __RPC_FAR * This,
            LPCTSTR name,
            UINT __RPC_FAR *pToolID);

        HRESULT ( __stdcall __RPC_FAR *RunTool )(
            ITcApp __RPC_FAR * This,
            UINT nToolID);

        HRESULT ( __stdcall __RPC_FAR *ToolGetInt )(
            ITcApp __RPC_FAR * This,
            int findex,
            int sindex,
            int WhichInt,
            long __RPC_FAR *prop);

        HRESULT ( __stdcall __RPC_FAR *ToolSetInt )(
            ITcApp __RPC_FAR * This,
            int findex,
            int sindex,
            int WhichInt,
            long prop);

        HRESULT ( __stdcall __RPC_FAR *ToolGetString )(
            ITcApp __RPC_FAR * This,
            int findex,
            int sindex,
            int WhichString,
            long lcid,
            BSTR __RPC_FAR *prop);

        HRESULT ( __stdcall __RPC_FAR *ToolSetString )(
            ITcApp __RPC_FAR * This,
            int findex,
            int sindex,
            int WhichString,
            long lcid,
            BSTR prop);

        HRESULT ( __stdcall __RPC_FAR *ToolGetActive )(
            ITcApp __RPC_FAR * This,
            int findex,
            int sindex,
            BOOL __RPC_FAR *prop);

        HRESULT ( __stdcall __RPC_FAR *ToolActivate )(
            ITcApp __RPC_FAR * This,
            int findex,
            int sindex);

        HRESULT ( __stdcall __RPC_FAR *DoPick )(
            ITcApp __RPC_FAR * This,
            int pickType,
            int __RPC_FAR *nAction,
            hDrawing __RPC_FAR *dPick,
            hViewport __RPC_FAR *vpPick,
            hExtents __RPC_FAR *ePick,
            long __RPC_FAR *snapModes);

        HRESULT ( __stdcall __RPC_FAR *GetCommandBarInfo )(
            ITcApp __RPC_FAR * This,
            CCommandBarInfo __RPC_FAR *__RPC_FAR *ppRoot,
            BOOL __RPC_FAR *pbDirty);

        HRESULT ( __stdcall __RPC_FAR *ConnectEvents )(
            ITcApp __RPC_FAR * This,
            IDispatch __RPC_FAR *EventSink,
            DWORD EventMask,
            long __RPC_FAR *ConnectionID);

        HRESULT ( __stdcall __RPC_FAR *DisconnectEvents )(
            ITcApp __RPC_FAR * This,
            long ConnectionID);

        HRESULT ( __stdcall __RPC_FAR *QueryMenu )(
            ITcApp __RPC_FAR * This,
            CCommandBarInfo __RPC_FAR *pItem,
            LPMENUITEMINFO lpmii);

        HRESULT ( __stdcall __RPC_FAR *ModifyMenu )(
            ITcApp __RPC_FAR * This,
            short what,
            CCommandBarInfo __RPC_FAR *__RPC_FAR *ppItem,
            LPARAM lParam);

        HRESULT ( __stdcall __RPC_FAR *OnSelectionChange )(
            ITcApp __RPC_FAR * This,
            BOOL bCreateSelector);

        HRESULT ( __stdcall __RPC_FAR *OpenCommandBarCfg )(
            ITcApp __RPC_FAR * This,
            LPCTSTR pszFileName,
            long sections);

        HRESULT ( __stdcall __RPC_FAR *SaveCommandBarCfg )(
            ITcApp __RPC_FAR * This,
            LPCTSTR pszFileName,
            long sections);

        HRESULT ( __stdcall __RPC_FAR *OnTurboLISP )(
            ITcApp __RPC_FAR * This,
            BOOL bActivate);

        END_INTERFACE
    } ITcAppVtbl;

    interface ITcApp
    {
        CONST_VTBL struct ITcAppVtbl __RPC_FAR *lpVtbl;
    };

#ifdef COBJMACROS

#define ITcApp_QueryInterface(This,riid,ppvObject)	\
    (This)->lpVtbl -> QueryInterface(This,riid,ppvObject)

#define ITcApp_AddRef(This)	\
    (This)->lpVtbl -> AddRef(This)

#define ITcApp_Release(This)	\
    (This)->lpVtbl -> Release(This)

#define ITcApp_GetTcDrawing(This,d,nDrawing,ppTcDrawing,Activate)	\
    (This)->lpVtbl -> GetTcDrawing(This,d,nDrawing,ppTcDrawing,Activate)

#define ITcApp_SetActiveDrawing(This,d,ppTcDrawing)	\
    (This)->lpVtbl -> SetActiveDrawing(This,d,ppTcDrawing)

#define ITcApp_GetActiveDrawing(This,ppTcDrawing)	\
    (This)->lpVtbl -> GetActiveDrawing(This,ppTcDrawing)

#define ITcApp_AbortScript(This)	\
    (This)->lpVtbl -> AbortScript(This)

#define ITcApp_FileOpen(This,pszPathName,ppTcDrawing)	\
    (This)->lpVtbl -> FileOpen(This,pszPathName,ppTcDrawing)

#define ITcApp_FileNew(This,pszTemplate,ppTcDrawing)	\
    (This)->lpVtbl -> FileNew(This,pszTemplate,ppTcDrawing)

#define ITcApp_Exit(This)	\
    (This)->lpVtbl -> Exit(This)

#define ITcApp_DragNew(This,nDraggerKind)	\
    (This)->lpVtbl -> DragNew(This,nDraggerKind)

#define ITcApp_DragNextPointDown(This,DraggerKind,x,y)	\
    (This)->lpVtbl -> DragNextPointDown(This,DraggerKind,x,y)

#define ITcApp_DragNextPointUp(This,DraggerKind,x,y)	\
    (This)->lpVtbl -> DragNextPointUp(This,DraggerKind,x,y)

#define ITcApp_DragReset(This,nFlags)	\
    (This)->lpVtbl -> DragReset(This,nFlags)

#define ITcApp_DragDraw(This,x,y)	\
    (This)->lpVtbl -> DragDraw(This,x,y)

#define ITcApp_DragLocalMenu(This,nID)	\
    (This)->lpVtbl -> DragLocalMenu(This,nID)

#define ITcApp_DragLocalMenuIndex(This,nItem)	\
    (This)->lpVtbl -> DragLocalMenuIndex(This,nItem)

#define ITcApp_DragGetLocalMenuSize(This,nItem,pSize)	\
    (This)->lpVtbl -> DragGetLocalMenuSize(This,nItem,pSize)

#define ITcApp_DragOnEnterKey(This,pResult)	\
    (This)->lpVtbl -> DragOnEnterKey(This,pResult)

#define ITcApp_DragOnCtrlEnterKey(This,pResult)	\
    (This)->lpVtbl -> DragOnCtrlEnterKey(This,pResult)

#define ITcApp_DragEditFieldChanged(This,nField,str,pResult)	\
    (This)->lpVtbl -> DragEditFieldChanged(This,nField,str,pResult)

#define ITcApp_DragEditFieldLock(This,nField)	\
    (This)->lpVtbl -> DragEditFieldLock(This,nField)

#define ITcApp_DragEditFieldUnlock(This,nField)	\
    (This)->lpVtbl -> DragEditFieldUnlock(This,nField)

#define ITcApp_DragGetAddedGraphic(This,pg)	\
    (This)->lpVtbl -> DragGetAddedGraphic(This,pg)

#define ITcApp_DragGetKind(This,pKind)	\
    (This)->lpVtbl -> DragGetKind(This,pKind)

#define ITcApp_SetSnapMode(This,nSnaps)	\
    (This)->lpVtbl -> SetSnapMode(This,nSnaps)

#define ITcApp_GetSnapMode(This,pSnaps)	\
    (This)->lpVtbl -> GetSnapMode(This,pSnaps)

#define ITcApp_SelectGraphic(This,g,bAddToSel)	\
    (This)->lpVtbl -> SelectGraphic(This,g,bAddToSel)

#define ITcApp_GetUserControl(This,userControl)	\
    (This)->lpVtbl -> GetUserControl(This,userControl)

#define ITcApp_SetUserControl(This,userControl)	\
    (This)->lpVtbl -> SetUserControl(This,userControl)

#define ITcApp_GetVisible(This,visible)	\
    (This)->lpVtbl -> GetVisible(This,visible)

#define ITcApp_SetVisible(This,visible)	\
    (This)->lpVtbl -> SetVisible(This,visible)

#define ITcApp_GetToolID(This,name,pToolID)	\
    (This)->lpVtbl -> GetToolID(This,name,pToolID)

#define ITcApp_RunTool(This,nToolID)	\
    (This)->lpVtbl -> RunTool(This,nToolID)

#define ITcApp_ToolGetInt(This,findex,sindex,WhichInt,prop)	\
    (This)->lpVtbl -> ToolGetInt(This,findex,sindex,WhichInt,prop)

#define ITcApp_ToolSetInt(This,findex,sindex,WhichInt,prop)	\
    (This)->lpVtbl -> ToolSetInt(This,findex,sindex,WhichInt,prop)

#define ITcApp_ToolGetString(This,findex,sindex,WhichString,lcid,prop)	\
    (This)->lpVtbl -> ToolGetString(This,findex,sindex,WhichString,lcid,prop)

#define ITcApp_ToolSetString(This,findex,sindex,WhichString,lcid,prop)	\
    (This)->lpVtbl -> ToolSetString(This,findex,sindex,WhichString,lcid,prop)

#define ITcApp_ToolGetActive(This,findex,sindex,prop)	\
    (This)->lpVtbl -> ToolGetActive(This,findex,sindex,prop)

#define ITcApp_ToolActivate(This,findex,sindex)	\
    (This)->lpVtbl -> ToolActivate(This,findex,sindex)

#define ITcApp_DoPick(This,pickType,nAction,dPick,vpPick,ePick,snapModes)	\
    (This)->lpVtbl -> DoPick(This,pickType,nAction,dPick,vpPick,ePick,snapModes)

#define ITcApp_GetCommandBarInfo(This,ppRoot,pbDirty)	\
    (This)->lpVtbl -> GetCommandBarInfo(This,ppRoot,pbDirty)

#define ITcApp_ConnectEvents(This,EventSink,EventMask,ConnectionID)	\
    (This)->lpVtbl -> ConnectEvents(This,EventSink,EventMask,ConnectionID)

#define ITcApp_DisconnectEvents(This,ConnectionID)	\
    (This)->lpVtbl -> DisconnectEvents(This,ConnectionID)

#define ITcApp_QueryMenu(This,pItem,lpmii)	\
    (This)->lpVtbl -> QueryMenu(This,pItem,lpmii)

#define ITcApp_ModifyMenu(This,what,ppItem,lParam)	\
    (This)->lpVtbl -> ModifyMenu(This,what,ppItem,lParam)

#define ITcApp_OnSelectionChange(This,bCreateSelector)	\
    (This)->lpVtbl -> OnSelectionChange(This,bCreateSelector)

#define ITcApp_OpenCommandBarCfg(This,pszFileName,sections)	\
    (This)->lpVtbl -> OpenCommandBarCfg(This,pszFileName,sections)

#define ITcApp_SaveCommandBarCfg(This,pszFileName,sections)	\
    (This)->lpVtbl -> SaveCommandBarCfg(This,pszFileName,sections)

#define ITcApp_OnTurboLISP(This,bActivate)	\
    (This)->lpVtbl -> OnTurboLISP(This,bActivate)

#endif /* COBJMACROS */

#endif 	/* C style interface */

HRESULT __stdcall ITcApp_GetTcDrawing_Proxy(
    ITcApp __RPC_FAR * This,
    hDrawing d,
    long nDrawing,
    ITcDrawing __RPC_FAR *__RPC_FAR *ppTcDrawing,
    BOOL Activate);

void __RPC_STUB ITcApp_GetTcDrawing_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_SetActiveDrawing_Proxy(
    ITcApp __RPC_FAR * This,
    hDrawing d,
    ITcDrawing __RPC_FAR *__RPC_FAR *ppTcDrawing);

void __RPC_STUB ITcApp_SetActiveDrawing_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_GetActiveDrawing_Proxy(
    ITcApp __RPC_FAR * This,
    ITcDrawing __RPC_FAR *__RPC_FAR *ppTcDrawing);

void __RPC_STUB ITcApp_GetActiveDrawing_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_AbortScript_Proxy(
    ITcApp __RPC_FAR * This);

void __RPC_STUB ITcApp_AbortScript_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_FileOpen_Proxy(
    ITcApp __RPC_FAR * This,
    LPCTSTR pszPathName,
    ITcDrawing __RPC_FAR *__RPC_FAR *ppTcDrawing);

void __RPC_STUB ITcApp_FileOpen_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_FileNew_Proxy(
    ITcApp __RPC_FAR * This,
    LPCTSTR pszTemplate,
    ITcDrawing __RPC_FAR *__RPC_FAR *ppTcDrawing);

void __RPC_STUB ITcApp_FileNew_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_Exit_Proxy(
    ITcApp __RPC_FAR * This);

void __RPC_STUB ITcApp_Exit_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DragNew_Proxy(
    ITcApp __RPC_FAR * This,
    UINT nDraggerKind);

void __RPC_STUB ITcApp_DragNew_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DragNextPointDown_Proxy(
    ITcApp __RPC_FAR * This,
    UINT DraggerKind,
    LONG x,
    LONG y);

void __RPC_STUB ITcApp_DragNextPointDown_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DragNextPointUp_Proxy(
    ITcApp __RPC_FAR * This,
    UINT DraggerKind,
    LONG x,
    LONG y);

void __RPC_STUB ITcApp_DragNextPointUp_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DragReset_Proxy(
    ITcApp __RPC_FAR * This,
    UINT nFlags);

void __RPC_STUB ITcApp_DragReset_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DragDraw_Proxy(
    ITcApp __RPC_FAR * This,
    LONG x,
    LONG y);

void __RPC_STUB ITcApp_DragDraw_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DragLocalMenu_Proxy(
    ITcApp __RPC_FAR * This,
    UINT nID);

void __RPC_STUB ITcApp_DragLocalMenu_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DragLocalMenuIndex_Proxy(
    ITcApp __RPC_FAR * This,
    int nItem);

void __RPC_STUB ITcApp_DragLocalMenuIndex_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DragGetLocalMenuSize_Proxy(
    ITcApp __RPC_FAR * This,
    int nItem,
    UINT __RPC_FAR *pSize);

void __RPC_STUB ITcApp_DragGetLocalMenuSize_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DragOnEnterKey_Proxy(
    ITcApp __RPC_FAR * This,
    UINT __RPC_FAR *pResult);

void __RPC_STUB ITcApp_DragOnEnterKey_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DragOnCtrlEnterKey_Proxy(
    ITcApp __RPC_FAR * This,
    UINT __RPC_FAR *pResult);

void __RPC_STUB ITcApp_DragOnCtrlEnterKey_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DragEditFieldChanged_Proxy(
    ITcApp __RPC_FAR * This,
    int nField,
    LPCSTR str,
    UINT __RPC_FAR *pResult);

void __RPC_STUB ITcApp_DragEditFieldChanged_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DragEditFieldLock_Proxy(
    ITcApp __RPC_FAR * This,
    UINT nField);

void __RPC_STUB ITcApp_DragEditFieldLock_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DragEditFieldUnlock_Proxy(
    ITcApp __RPC_FAR * This,
    UINT nField);

void __RPC_STUB ITcApp_DragEditFieldUnlock_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DragGetAddedGraphic_Proxy(
    ITcApp __RPC_FAR * This,
    hGraphic __RPC_FAR *pg);

void __RPC_STUB ITcApp_DragGetAddedGraphic_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DragGetKind_Proxy(
    ITcApp __RPC_FAR * This,
    UINT __RPC_FAR *pKind);

void __RPC_STUB ITcApp_DragGetKind_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_SetSnapMode_Proxy(
    ITcApp __RPC_FAR * This,
    UINT nSnaps);

void __RPC_STUB ITcApp_SetSnapMode_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_GetSnapMode_Proxy(
    ITcApp __RPC_FAR * This,
    UINT __RPC_FAR *pSnaps);

void __RPC_STUB ITcApp_GetSnapMode_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_SelectGraphic_Proxy(
    ITcApp __RPC_FAR * This,
    hGraphic g,
    BOOL bAddToSel);

void __RPC_STUB ITcApp_SelectGraphic_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_GetUserControl_Proxy(
    ITcApp __RPC_FAR * This,
    BOOL __RPC_FAR *userControl);

void __RPC_STUB ITcApp_GetUserControl_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_SetUserControl_Proxy(
    ITcApp __RPC_FAR * This,
    BOOL userControl);

void __RPC_STUB ITcApp_SetUserControl_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_GetVisible_Proxy(
    ITcApp __RPC_FAR * This,
    BOOL __RPC_FAR *visible);

void __RPC_STUB ITcApp_GetVisible_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_SetVisible_Proxy(
    ITcApp __RPC_FAR * This,
    BOOL visible);

void __RPC_STUB ITcApp_SetVisible_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_GetToolID_Proxy(
    ITcApp __RPC_FAR * This,
    LPCTSTR name,
    UINT __RPC_FAR *pToolID);

void __RPC_STUB ITcApp_GetToolID_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_RunTool_Proxy(
    ITcApp __RPC_FAR * This,
    UINT nToolID);

void __RPC_STUB ITcApp_RunTool_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_ToolGetInt_Proxy(
    ITcApp __RPC_FAR * This,
    int findex,
    int sindex,
    int WhichInt,
    long __RPC_FAR *prop);

void __RPC_STUB ITcApp_ToolGetInt_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_ToolSetInt_Proxy(
    ITcApp __RPC_FAR * This,
    int findex,
    int sindex,
    int WhichInt,
    long prop);

void __RPC_STUB ITcApp_ToolSetInt_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_ToolGetString_Proxy(
    ITcApp __RPC_FAR * This,
    int findex,
    int sindex,
    int WhichString,
    long lcid,
    BSTR __RPC_FAR *prop);

void __RPC_STUB ITcApp_ToolGetString_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_ToolSetString_Proxy(
    ITcApp __RPC_FAR * This,
    int findex,
    int sindex,
    int WhichString,
    long lcid,
    BSTR prop);

void __RPC_STUB ITcApp_ToolSetString_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_ToolGetActive_Proxy(
    ITcApp __RPC_FAR * This,
    int findex,
    int sindex,
    BOOL __RPC_FAR *prop);

void __RPC_STUB ITcApp_ToolGetActive_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_ToolActivate_Proxy(
    ITcApp __RPC_FAR * This,
    int findex,
    int sindex);

void __RPC_STUB ITcApp_ToolActivate_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DoPick_Proxy(
    ITcApp __RPC_FAR * This,
    int pickType,
    int __RPC_FAR *nAction,
    hDrawing __RPC_FAR *dPick,
    hViewport __RPC_FAR *vpPick,
    hExtents __RPC_FAR *ePick,
    long __RPC_FAR *snapModes);

void __RPC_STUB ITcApp_DoPick_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_GetCommandBarInfo_Proxy(
    ITcApp __RPC_FAR * This,
    CCommandBarInfo __RPC_FAR *__RPC_FAR *ppRoot,
    BOOL __RPC_FAR *pbDirty);

void __RPC_STUB ITcApp_GetCommandBarInfo_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_ConnectEvents_Proxy(
    ITcApp __RPC_FAR * This,
    IDispatch __RPC_FAR *EventSink,
    DWORD EventMask,
    long __RPC_FAR *ConnectionID);

void __RPC_STUB ITcApp_ConnectEvents_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_DisconnectEvents_Proxy(
    ITcApp __RPC_FAR * This,
    long ConnectionID);

void __RPC_STUB ITcApp_DisconnectEvents_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_QueryMenu_Proxy(
    ITcApp __RPC_FAR * This,
    CCommandBarInfo __RPC_FAR *pItem,
    LPMENUITEMINFO lpmii);

void __RPC_STUB ITcApp_QueryMenu_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_ModifyMenu_Proxy(
    ITcApp __RPC_FAR * This,
    short what,
    CCommandBarInfo __RPC_FAR *__RPC_FAR *ppItem,
    LPARAM lParam);

void __RPC_STUB ITcApp_ModifyMenu_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_OnSelectionChange_Proxy(
    ITcApp __RPC_FAR * This,
    BOOL bCreateSelector);

void __RPC_STUB ITcApp_OnSelectionChange_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_OpenCommandBarCfg_Proxy(
    ITcApp __RPC_FAR * This,
    LPCTSTR pszFileName,
    long sections);

void __RPC_STUB ITcApp_OpenCommandBarCfg_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_SaveCommandBarCfg_Proxy(
    ITcApp __RPC_FAR * This,
    LPCTSTR pszFileName,
    long sections);

void __RPC_STUB ITcApp_SaveCommandBarCfg_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcApp_OnTurboLISP_Proxy(
    ITcApp __RPC_FAR * This,
    BOOL bActivate);

void __RPC_STUB ITcApp_OnTurboLISP_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

#endif 	/* __ITcApp_INTERFACE_DEFINED__ */

#ifndef __ITcDrawing_INTERFACE_DEFINED__
#define __ITcDrawing_INTERFACE_DEFINED__

/****************************************
 * Generated header for interface: ITcDrawing
 * at Thu Mar 12 13:59:03 1998
 * using MIDL 3.01.75
 ****************************************/
/* [unique][helpstring][helpcontext][uuid][local][object] */

EXTERN_C const IID IID_ITcDrawing;

#if defined(__cplusplus) && !defined(CINTERFACE)

    interface DECLSPEC_UUID("6A481201-E531-11CF-A115-00A024158DAF")//# Non-localizable string#
    ITcDrawing : public IUnknown
    {
    public:
        virtual HRESULT __stdcall Save(
            LPCTSTR pszPathName,
            BOOL bSelection) = 0;

        virtual HRESULT __stdcall Close(
            BOOL bSaveChanges) = 0;

        virtual HRESULT __stdcall Print(
            BOOL bShowDialog) = 0;

        virtual HRESULT __stdcall SetPageSetup(
            const PageSetupParams __RPC_FAR *pSetup) = 0;

        virtual HRESULT __stdcall GetPageSetup(
            PageSetupParams __RPC_FAR *pSetup) = 0;

        virtual HRESULT __stdcall GetRelativeOrigin(
            hVertex v) = 0;

    };

#else 	/* C style interface */

    typedef struct ITcDrawingVtbl
    {
        BEGIN_INTERFACE

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *QueryInterface )(
            ITcDrawing __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [iid_is][out] */ void __RPC_FAR *__RPC_FAR *ppvObject);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *AddRef )(
            ITcDrawing __RPC_FAR * This);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *Release )(
            ITcDrawing __RPC_FAR * This);

        HRESULT ( __stdcall __RPC_FAR *Save )(
            ITcDrawing __RPC_FAR * This,
            LPCTSTR pszPathName,
            BOOL bSelection);

        HRESULT ( __stdcall __RPC_FAR *Close )(
            ITcDrawing __RPC_FAR * This,
            BOOL bSaveChanges);

        HRESULT ( __stdcall __RPC_FAR *Print )(
            ITcDrawing __RPC_FAR * This,
            BOOL bShowDialog);

        HRESULT ( __stdcall __RPC_FAR *SetPageSetup )(
            ITcDrawing __RPC_FAR * This,
            const PageSetupParams __RPC_FAR *pSetup);

        HRESULT ( __stdcall __RPC_FAR *GetPageSetup )(
            ITcDrawing __RPC_FAR * This,
            PageSetupParams __RPC_FAR *pSetup);

        HRESULT ( __stdcall __RPC_FAR *GetRelativeOrigin )(
            ITcDrawing __RPC_FAR * This,
            hVertex v);

        END_INTERFACE
    } ITcDrawingVtbl;

    interface ITcDrawing
    {
        CONST_VTBL struct ITcDrawingVtbl __RPC_FAR *lpVtbl;
    };

#ifdef COBJMACROS

#define ITcDrawing_QueryInterface(This,riid,ppvObject)	\
    (This)->lpVtbl -> QueryInterface(This,riid,ppvObject)

#define ITcDrawing_AddRef(This)	\
    (This)->lpVtbl -> AddRef(This)

#define ITcDrawing_Release(This)	\
    (This)->lpVtbl -> Release(This)

#define ITcDrawing_Save(This,pszPathName,bSelection)	\
    (This)->lpVtbl -> Save(This,pszPathName,bSelection)

#define ITcDrawing_Close(This,bSaveChanges)	\
    (This)->lpVtbl -> Close(This,bSaveChanges)

#define ITcDrawing_Print(This,bShowDialog)	\
    (This)->lpVtbl -> Print(This,bShowDialog)

#define ITcDrawing_SetPageSetup(This,pSetup)	\
    (This)->lpVtbl -> SetPageSetup(This,pSetup)

#define ITcDrawing_GetPageSetup(This,pSetup)	\
    (This)->lpVtbl -> GetPageSetup(This,pSetup)

#define ITcDrawing_GetRelativeOrigin(This,v)	\
    (This)->lpVtbl -> GetRelativeOrigin(This,v)

#endif /* COBJMACROS */

#endif 	/* C style interface */

HRESULT __stdcall ITcDrawing_Save_Proxy(
    ITcDrawing __RPC_FAR * This,
    LPCTSTR pszPathName,
    BOOL bSelection);

void __RPC_STUB ITcDrawing_Save_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcDrawing_Close_Proxy(
    ITcDrawing __RPC_FAR * This,
    BOOL bSaveChanges);

void __RPC_STUB ITcDrawing_Close_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcDrawing_Print_Proxy(
    ITcDrawing __RPC_FAR * This,
    BOOL bShowDialog);

void __RPC_STUB ITcDrawing_Print_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcDrawing_SetPageSetup_Proxy(
    ITcDrawing __RPC_FAR * This,
    const PageSetupParams __RPC_FAR *pSetup);

void __RPC_STUB ITcDrawing_SetPageSetup_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcDrawing_GetPageSetup_Proxy(
    ITcDrawing __RPC_FAR * This,
    PageSetupParams __RPC_FAR *pSetup);

void __RPC_STUB ITcDrawing_GetPageSetup_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

HRESULT __stdcall ITcDrawing_GetRelativeOrigin_Proxy(
    ITcDrawing __RPC_FAR * This,
    hVertex v);

void __RPC_STUB ITcDrawing_GetRelativeOrigin_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

#endif 	/* __ITcDrawing_INTERFACE_DEFINED__ */

/* Additional Prototypes for ALL interfaces */

/* end of Additional Prototypes */

#ifdef __cplusplus
}
#endif

#endif


Examples - C++ Insert Symbol Tool - TDialog1.cpp

TDialog1.cpp

C++ Insert Symbol Tool Example

// TDialog1.cpp : implementation file
//

#include "stdafx.h"
#include "instool.h"
#include "InsSymb.h"
#include "TDialog1.h"
#include "ViewWnd.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CTDialog1 dialog

CTDialog1::CTDialog1(CInsSymb* pTool, CWnd* pParent /*=NULL*/)
    : CDialog(CTDialog1::IDD, pParent)
{
    m_pTool = pTool;
    //{{AFX_DATA_INIT(CTDialog1)
        // NOTE: the ClassWizard will add member initialization here
    //}}AFX_DATA_INIT
}

void CTDialog1::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CTDialog1)
        // NOTE: the ClassWizard will add DDX and DDV calls here
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CTDialog1, CDialog)
    //{{AFX_MSG_MAP(CTDialog1)
    ON_EN_CHANGE(IDC_EDITSCALEX, OnChangeEditscalex)
    ON_EN_KILLFOCUS(IDC_EDITSCALEX, OnKillfocusEditscalex)
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CTDialog1 message handlers

void CTDialog1::OnOK()
{
    // TODO: Add extra validation here
    COleVariant varOptional(varMissing);
    COleVariant varItem(0L);

    char textx[6];// = "***";
    char texty[6];// = "***";
    char textz[6];// = "***";
    char tz[6];
    double x, y, z;
    double angleZ;
    angleZ = 0;

    IDrawing* pIDr = NULL;
    IGraphic *pIGr = NULL;
    Graphics* pGrs = NULL;
    IMatrix *pIMat = NULL;

    try
    {
        CViewWnd *pView = (CViewWnd *)(GetParent()->GetDlgItem(IDC_PREVIEW));

        HRESULT hRes = pView->m_pPreviewView->get_Drawing(&pIDr);
        CHECK_HRESULT(hRes)

        hRes = pIDr->get_Graphics(&pGrs);
        CHECK_HRESULT(hRes)

        hRes = pGrs->get_Item(&varItem, &pIGr);
        CHECK_HRESULT(hRes)

//	CEdit *S1 = (CEdit *) GetDlgItem(IDC_EDITSCALEX);

        //LPTSTR text = "***";
        x = y = z = 1;

        AFX_MANAGE_STATE(m_pTool->m_pTCState);

        COleVariant varVal(1L);
        m_AngleZ->GetLine(0, tz);
        angleZ = atof(tz); // convert text from Axis - Z edit box to double

        angleZ = (angleZ*3.14159265359)/180; //calculate angle in radians

        hRes = pIGr->RotateAxis(angleZ, varOptional, varOptional, varVal, varOptional, varOptional, varOptional, &pIMat);
        CHECK_HRESULT(hRes)

        if (pIMat != NULL)
        {
            pIMat->Release();
            pIMat = NULL;
        }

        hRes = pView->m_pPreviewView->ZoomToExtents();
        CHECK_HRESULT(hRes)

        m_ScaleX->GetLine(0, textx);
        x = atof(textx);
        if (x == 0)
            x = 1;

        m_ScaleY->GetLine(0, texty);
        y = atof(texty);
        if (y ==0)
            y = 1;

///		m_ScaleZ->GetLine(0, textz);
///		z = atof(textz);
///		if (z == 0)
///			z = 1;
//		textz = NULL;

        hRes = pIGr->Scale(x, y, z, varOptional, varOptional, varOptional, &pIMat);
        CHECK_HRESULT(hRes)

        pView->Invalidate();

    }

    catch (...)
    {
        TRACE_EXCEPTION("CTDialog1::OnOK")
        _clearfp();
    }

    if (pIMat != NULL)
    {
        pIMat->Release();
        pIMat = NULL;
    }

    if (pIGr != NULL)
    {
        pIGr->Release();
        pIGr = NULL;
    }

    if (pGrs != NULL)
    {
        pGrs->Release();
        pGrs = NULL;

    }

    if(pIDr != NULL)
    {
        pIDr->Release();
        pIDr = NULL;

    }

    CDialog::OnOK();
}

void CTDialog1::OnCancel()
{
    // TODO: Add extra cleanup here

    CDialog::OnCancel();
}

void CTDialog1::OnChangeEditscalex()
{

    // TODO: If this is a RICHEDIT control, the control will not
    // send this notification unless you override the CDialog::OnInitDialog()
    // function and call CRichEditCtrl().SetEventMask()
    // with the ENM_CHANGE flag ORed into the mask.

    // TODO: Add your control notification handler code here

}

BOOL CTDialog1::OnInitDialog()
{
    CDialog::OnInitDialog();

    // TODO: Add extra initialization here
    m_ScaleX = (CEdit *) GetDlgItem(IDC_EDITSCALEX);
    m_ScaleX->SetLimitText(6);
    m_ScaleX->SetWindowText("1");

    m_ScaleY = (CEdit *) GetDlgItem(IDC_EDITSCALEY);
    m_ScaleY->SetLimitText(6);
    m_ScaleY->SetWindowText("1");

    m_ScaleZ = (CEdit *) GetDlgItem(IDC_EDITSCALEZ);
    m_ScaleZ->SetLimitText(6);
    m_ScaleZ->SetWindowText("1");

    m_AngleX = (CEdit *) GetDlgItem(IDC_EDITANGLEX);
    m_AngleX->SetLimitText(6);
    m_AngleX->SetWindowText("0");

    m_AngleY = (CEdit *) GetDlgItem(IDC_EDITANGLEY);
    m_AngleY->SetLimitText(6);
    m_AngleY->SetWindowText("0");

    m_AngleZ = (CEdit *) GetDlgItem(IDC_EDITANGLEZ);
    m_AngleZ->SetLimitText(6);
    m_AngleZ->SetWindowText("0");

    return TRUE;  // return TRUE unless you set the focus to a control
                  // EXCEPTION: OCX Property Pages should return FALSE
}

void CTDialog1::OnKillfocusEditscalex()
{
    // TODO: Add your control notification handler code here

}


Examples - C++ Insert Symbol Tool - TDialog1.h

TDialog1.h

C++ Insert Symbol Tool Example

#if !defined(AFX_TDIALOG1_H__8CCE8643_8F35_11D2_8BFF_00403338C504__INCLUDED_)
#define AFX_TDIALOG1_H__8CCE8643_8F35_11D2_8BFF_00403338C504__INCLUDED_

#include "InsSymb.h"

#if _MSC_VER > 1000
#pragma once
#endif // _MSC_VER > 1000
// TDialog1.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CTDialog1 dialog

class CTDialog1 : public CDialog
{
// Construction
public:
    CEdit* m_AngleX;
    CEdit* m_AngleY;
    CEdit* m_AngleZ;
    CEdit* m_ScaleX;
    CEdit* m_ScaleY;
    CEdit* m_ScaleZ;

    CTDialog1(CInsSymb* pTool, CWnd* pParent = NULL);   // standard constructor

// Dialog Data
    //{{AFX_DATA(CTDialog1)
    enum { IDD = IDD_DIALOG2 };
        // NOTE: the ClassWizard will add data members here
    //}}AFX_DATA

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CTDialog1)
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:
    CInsSymb *m_pTool;

    // Generated message map functions
    //{{AFX_MSG(CTDialog1)
    virtual void OnOK();
    virtual void OnCancel();
    afx_msg void OnChangeEditscalex();
    virtual BOOL OnInitDialog();
    afx_msg void OnKillfocusEditscalex();
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

//{{AFX_INSERT_LOCATION}}
// Microsoft Visual C++ will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_TDIALOG1_H__8CCE8643_8F35_11D2_8BFF_00403338C504__INCLUDED_)


Examples - C++ Insert Symbol Tool - TDialog.cpp

TDialog.cpp

C++ Insert Symbol Tool Example

// TDialog.cpp : implementation file
//
#include <afxwin.h>
#include "stdafx.h"
#include "InsTool.h"
#include "InsSymb.h"
#include "ViewWnd.h"
#include "TDialog.h"
#include "TDialog1.h"
#include "Dirdialog.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/*
const IID LIBID_IMSIGXLib = {0x6A481400,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_PickResult = {0x6A481123,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
//const IID IID_Tool = {0x6A48112C,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_Graphics = {0x6A48110A, 0xE531, 0x11CF, {0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_View = {0x6A481110, 0xE531, 0x11CF, {0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_Window = {0x6A481124, 0xE531, 0x11CF, {0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF} };
const CLSID CLSID_Application  = {0x6A481001,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const CLSID CLSID_XGraphic  = {0x6A481803,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
static const IID IID_IAppEvents = { 0x6A481301, 0xE531, 0x11CF, { 0xA1, 0x15, 0x0, 0xA0, 0x24, 0x15, 0x8D, 0xAF } };
*/

/////////////////////////////////////////////////////////////////////////////
BEGIN_MESSAGE_MAP(CTDialog, CDialog)
    //{{AFX_MSG_MAP(CTDialog)
    ON_BN_CLICKED(ID_CLOSE, OnClose)
    ON_BN_CLICKED(IDC_BROWSE, OnBrowse)
    ON_BN_CLICKED(IDC_MODIFY, OnModify)
    ON_BN_CLICKED(IDC_CHECK1, OnCheck1)
    ON_WM_SYSCOMMAND()
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

BEGIN_DISPATCH_MAP(CTDialog, CDialog)
    //{{AFX_DISPATCH_MAP(CTDialog)
        // NOTE - the ClassWizard will add and remove mapping macros here.
    DISP_FUNCTION(CTDialog, "MouseDown", MouseDown, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_I2 VTS_I4 VTS_I4 VTS_I4 VTS_PBOOL)
    DISP_FUNCTION(CTDialog, "MouseUp", MouseUp, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_I2 VTS_I4 VTS_I4 VTS_I4 VTS_PBOOL)
    DISP_FUNCTION(CTDialog, "MouseMove", MouseMove, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_I4 VTS_I4 VTS_I4 VTS_PBOOL)
//	DISP_FUNCTION(CTDialog,	"DrawingBeforeClose", DrawingBeforeClose, VT_EMPTY, VTS_DISPATCH VTS_DISPATCH VTS_DISPATCH VTS_I4 VTS_I4 VTS_I4 VTS_PBOOL)
    DISP_FUNCTION(CTDialog,	"DrawingBeforeClose", DrawingBeforeClose, VT_EMPTY, VTS_DISPATCH VTS_PBOOL)

    //}}AFX_DISPATCH_MAP

END_DISPATCH_MAP()

// Note: we add support for IID_ITDialog to support typesafe binding
//  from VBA.  This IID must match the GUID that is attached to the
//  dispinterface in the .ODL file.

// {0416A816-839B-11D2-82F6-006052012837}
///static const IID IID_ITDialog =
///{ 0x416a816, 0x839b, 0x11d2, { 0x82, 0xf6, 0x0, 0x60, 0x52, 0x1, 0x28, 0x37 } };

BEGIN_INTERFACE_MAP(CTDialog, CDialog)
    INTERFACE_PART(CTDialog, IID_IAppEvents, Dispatch)
END_INTERFACE_MAP()

/////////////////////////////////////////////////////////////////////////////

// CTDialog dialog

CTDialog::CTDialog(CInsSymb* pTool, CWnd* pParent, /*=NULL*/Tool *pThisTool)
    : CDialog(CTDialog::IDD, pParent),
    m_dwEventConnection(0),
    m_dwEventMask(~0UL),
    m_pIApplication(NULL),
    m_FirstClick(FALSE),
    m_bDragging(FALSE),
    m_pDragGraphic(NULL),
    m_pView(NULL),
    m_pThisTool(NULL),
    m_wndView(pTool)

{
    EnableAutomation();

    //{{AFX_DATA_INIT(CTDialog)
        // NOTE: the ClassWizard will add member initialization here
    //}}AFX_DATA_INIT

    m_pTool = pTool;
    m_pTool->AddRef();

    m_pTool->m_bRunned = TRUE;

    m_pThisTool = pThisTool;
    m_pThisTool->AddRef();
}

/*
void CTDialog::OnFinalRelease()
{
    // When the last reference for an automation object is released
    // OnFinalRelease is called.  The base class will automatically
    // deletes the object.  Add additional cleanup required for your
    // object before calling the base class.

    CDialog::OnFinalRelease();
}
*/
void CTDialog::DoDataExchange(CDataExchange* pDX)
{
    CDialog::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CTDialog)
        // NOTE: the ClassWizard will add DDX and DDV calls here
    //}}AFX_DATA_MAP
}

// CTDialog message handlers
BOOL CTDialog::OnInitDialog()
{

    BSTR bstrName;
    CString cstrPropName;
    CString cstrInitPath;
    COleVariant varItem;
    COleVariant varVal;
    Properties *pProps = NULL;
    Property *pProp = NULL;
    HRESULT hRes = E_FAIL;
    BOOL ret = FALSE;

    CDialog::OnInitDialog();
    m_list.SubclassDlgItem( IDC_LIST1 , this );
    CToolList *pList = (CToolList *)GetDlgItem(IDC_LIST1);

    try
    {

/*
        hRes = m_pThisTool->get_Application(&m_pIApplication);
        CHECK_HRESULT(hRes)
        hRes = m_pIApplication->get_Properties(&pProps);
        CHECK_HRESULT(hRes)

        cstrPropName = "$SYMLIBPATH";

        bstrName = cstrPropName.AllocSysString();
        ::VariantInit(&varItem);
        varItem.vt = VT_BSTR;
        varItem.bstrVal = bstrName;

        hRes =pProps->get_Item (&varItem, &pProp);
        CHECK_HRESULT(hRes);

        varVal.vt = VT_BSTR;

        hRes = pProp->get_Value (NULL, &varVal);
        CHECK_HRESULT(hRes);

        cstrInitPath = varVal.bstrVal;

        if (cstrInitPath.IsEmpty ())
        {
            cstrInitPath = "c\\";

        }
*/

        HMODULE hHdl = NULL;
        char path[256];

        DWORD dBufSize = 256;
        DWORD dW = 0;

        hHdl = GetModuleHandle(NULL);

        dW = GetModuleFileName(hHdl, path, dBufSize);
        hHdl = NULL;

        cstrInitPath = path;
        cstrInitPath = cstrInitPath.Left(cstrInitPath.GetLength () - 10); // delete module name from path

//		cstrInitPath = "c:\\";
        pList->RefreshFileList(cstrInitPath);

        CEdit *pPath = (CEdit *) GetDlgItem(IDC_EDITPATH);
        pPath->SetWindowText(cstrInitPath);
        CString selected;

        m_wndView.SubclassDlgItem(IDC_PREVIEW, this);
        CViewWnd *pView = (CViewWnd *)GetDlgItem(IDC_PREVIEW);
    //	ConnectEvents();
        if(pList->SetCurSel(0) != LB_ERR)
        {

            pList->GetText(0 ,(pList->m_cstrCurSelected));

            pView->CreatePreview();
            pView->DoPreview();
            ConnectEvents();

        }
        else
        {
            ConnectEvents();
        }
        ret = TRUE;
    }

    catch (...)
    {
        TRACE_EXCEPTION("CTDialog::OnInitDialog")
        _clearfp();
    }
//	RELEASE(pProp)
//	RELEASE(pProps)
//	RELEASE(m_pIApplication)
    // TODO: Add extra initialization here

    return ret;  // return TRUE unless you set the focus to a control
                  // EXCEPTION: OCX Property Pages should return FALSE
}

void CTDialog::OnClose()
{
    // TODO: Add your message handler code here and/or call default
    if(m_dwEventConnection != 0)
        DisconectEvents();

    CViewWnd *pView = (CViewWnd *)GetDlgItem(IDC_PREVIEW);
    pView->ClearAll();

    m_pTool->m_bRunned = FALSE;
    if(m_pTool != NULL)
    {
        m_pTool->Release();
        m_pTool = NULL;

    }
    if(m_pThisTool != NULL)
    {
        m_pThisTool->Release();
        m_pThisTool = NULL;

    }

    CDialog::OnClose();
    DestroyWindow();

}

void CTDialog::OnSysCommand(UINT nID, LPARAM lParam )
{
    if (nID == SC_CLOSE)
    {
        if(m_dwEventConnection != 0)
        DisconectEvents();

        CViewWnd *pView = (CViewWnd *)GetDlgItem(IDC_PREVIEW);
        pView->ClearAll();
        m_pTool->m_bRunned = FALSE;
        if(m_pTool != NULL)
        {
            m_pTool->Release();
            m_pTool = NULL;

        }
        if(m_pThisTool != NULL)
        {
            m_pThisTool->Release();
            m_pThisTool = NULL;

        }

    }
    CDialog::OnSysCommand(nID, lParam );

}

void CTDialog::OnModify()
{
    // TODO: Add your control notification handler code here
        CWnd *pMainWnd = AfxGetMainWnd();
        CTDialog1 *pdlg1 = new CTDialog1(m_pTool, pMainWnd);
        int i =	pdlg1->DoModal();

}

void CTDialog::OnCheck1()
{
    // TODO: Add your control notification handler code here

    CViewWnd *pView = (CViewWnd *)GetDlgItem(IDC_PREVIEW);
    AFX_MANAGE_STATE(m_pTool->m_pTCState);

    Properties *pProps = NULL;
    Property *pProp = NULL;
    VARIANT varVal;//(0L);
    varVal.vt = VT_I2;

    CString cstrName("TileMode");//# Non-localizable string#
    BSTR bstrName = cstrName.AllocSysString();

    VARIANT varItem;
  ::VariantInit(&varItem);
    varItem.vt = VT_BSTR;
    varItem.bstrVal = bstrName;
    try
    {

        if(pView->m_pPreviewDrawing != NULL)
        {
            HRESULT hRes = pView->m_pPreviewDrawing->get_Properties(&pProps);
            CHECK_HRESULT(hRes)

            hRes = pProps->get_Item(&varItem, &pProp);
            CHECK_HRESULT(hRes)

            pProp->get_Value(NULL, &varVal);

            if (varVal.iVal == 0) // cur drawing mode is paper space
            {
                varVal.iVal = 1;
                hRes = pProp->put_Value(NULL, &varVal);
                CHECK_HRESULT(hRes)

            }
            else  // cur drawing mode is model space
            {
                varVal.iVal = 0;
                hRes = pProp->put_Value(NULL, &varVal); // switch the preview drawing to paper space
                CHECK_HRESULT(hRes)

            }

            pView->Invalidate();

            hRes = pView->m_pPreviewView->ZoomToExtents();
            CHECK_HRESULT(hRes)

            hRes = pView->m_pPreviewView->Refresh();
            CHECK_HRESULT(hRes)
            ::VariantClear(&varItem);
        }

    }
    catch (...)
    {
        _clearfp();

        TRACE_EXCEPTION("TDialog::OnCheck1")
    }

    if (pProp != NULL)
    {
        pProp->Release();
        pProp = NULL;
    }
    if (pProps != NULL)
    {
        pProps->Release();
        pProps = NULL;
    }

}
void CTDialog::DrawingBeforeClose(LPDISPATCH WhichDrawing, BOOL FAR* Cancel)
{
    *Cancel = FALSE;
    Drawings *pDrs = NULL;
    long n = 0;

    try
    {
        HRESULT hRes = m_pIApplication->get_Drawings(&pDrs);
        CHECK_HRESULT(hRes)
        hRes = pDrs->get_Count(&n);
        CHECK_HRESULT(hRes)
        if (n == 2)
        {
            if(m_dwEventConnection != 0)
                DisconectEvents();

            CViewWnd *m_wndView = (CViewWnd *)GetDlgItem(IDC_PREVIEW);
            m_wndView->ClearAll();

            m_pTool->m_bRunned = FALSE;

            CDialog::OnClose();
            DestroyWindow();
        }

    }

    catch (...)
    {
        _clearfp();

        TRACE_EXCEPTION("TDialog::DrawingBeforeClose")
    }
    if (pDrs != NULL)
    {
        pDrs->Release();
        pDrs = NULL;
    }

}
void CTDialog::MouseDown(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel)
{
    *pbCancel = FALSE;

}

void CTDialog::MouseUp(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel)
{
    *pbCancel = FALSE;
    HRESULT hRes = E_FAIL;
    CMerge merge;
    IDrawing *pIDwgTrg = NULL;
    Graphics *pGrs = NULL;
    COleVariant varOptional(varMissing);

    CViewWnd *pView = (CViewWnd *)GetDlgItem(IDC_PREVIEW);

    AFX_MANAGE_STATE(m_pTool->m_pTCState);

    try
    {
        if(m_pDragGraphic != 0)
        {

            pIDwgTrg = (IDrawing*)WhichDrawing;

            pIDwgTrg->AddRef();

            hRes = merge.InitA(pView->m_pPreviewDrawing, pIDwgTrg);
            CHECK_HRESULT(hRes)

            hRes = merge.RunA();
            CHECK_HRESULT(hRes)

            hRes = pIDwgTrg->get_Graphics(&pGrs); // get current drawing graphic collection
            CHECK_HRESULT(hRes)

            hRes = pGrs->AddGraphic(m_pDragGraphic, varOptional, varOptional);
            CHECK_HRESULT(hRes)

            hRes = merge.CorrectGraphic(m_pDragGraphic);
            CHECK_HRESULT(hRes)

            hRes = m_pDragGraphic->Update();
            CHECK_HRESULT(hRes)

            pIDwgTrg->Release();
            pIDwgTrg = NULL;

            CPoint point;
            point.x = X;
            point.y = Y;

            m_pView = (View*) WhichView;
            m_pView->AddRef();

            EndDrag(point);

            hRes = m_pView->Refresh();
            CHECK_HRESULT(hRes)

            m_FirstClick = FALSE;
        }
    }
    catch (...)
    {
        _clearfp();

        TRACE_EXCEPTION("TDialog::MouseUp")
    }

    if (m_pView != NULL)
    {
        m_pView->Release();
        m_pView = NULL;
    }
    if (pGrs != NULL)
    {
        pGrs->Release();
        pGrs = NULL;
    }

}
void CTDialog::MouseMove(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, long Shift, long X, long Y, IMSI_BOOL* pbCancel)
{
    *pbCancel = FALSE;

    CPoint point;
    point.x = X;
    point.y = Y;
    Graphics* GrsTmp = NULL;;
    Graphics* pPreviewGrs = NULL;;
    IGraphic* Gr1 = NULL;
    long c = 0;
    IDrawing *pIDwgTrg = NULL;
    Graphics *pGrs = NULL;
    View *pViewCur = NULL;

    try
    {

        if (m_FirstClick == TRUE)/// && m_bDragging != FALSE)
        {

            if(m_pView != NULL)
            {
                m_pView->Release();
            }
            m_pView = (View *)WhichView;
            m_pView->AddRef();

            CViewWnd *pPreview = (CViewWnd *) (GetDlgItem(IDC_PREVIEW));

            COleVariant varItem = (1L);

            HRESULT hRes = pPreview->m_pPreviewDrawing->get_Graphics(&pPreviewGrs);
            CHECK_HRESULT(hRes)

#ifdef _DEBUG
            hRes = pPreviewGrs->get_Count(&c);
            CHECK_HRESULT(hRes)
#endif

            varItem = 0L;

            hRes = pPreviewGrs->get_Item(varItem, &Gr1);
            CHECK_HRESULT(hRes)
// check if the graphic that we drag is empty
            hRes = Gr1->get_Graphics(&GrsTmp);
            CHECK_HRESULT(hRes)

            long b = 0;
            hRes = GrsTmp->get_Count(&b);
            CHECK_HRESULT(hRes)

            if (b == 0) //if it is empty then return;
            {

                GrsTmp->Release();
                GrsTmp = NULL;

                Gr1->Release();
                Gr1 = NULL;

                pPreviewGrs->Release();
                pPreviewGrs = NULL;

                m_FirstClick = TRUE;
                return;
            }

            hRes = Gr1->Duplicate(&m_pDragGraphic);
            CHECK_HRESULT(hRes)

            m_pDragGraphic->Release();
            m_pDragGraphic = NULL;

            hRes = pPreviewGrs->get_Count(&c);
            CHECK_HRESULT(hRes)
            varItem = c -1L;
            hRes = pPreviewGrs->Remove(&varItem, &m_pDragGraphic);
            CHECK_HRESULT(hRes)
            m_FirstClick = FALSE;
            BeginDrag(point);
        }
        else
        {
            if (m_pDragGraphic != NULL && !m_bDragging)/// aalb && (nFlags & MK_LBUTTON))
            {
                if (!BeginDrag(point))
                {
                    m_pDragGraphic->Release();
                    m_pDragGraphic = NULL;
                }
            }
            else if (m_bDragging)
            {

                pViewCur = (View *)WhichView;
                pViewCur->AddRef();
                if (pViewCur != m_pView) // if view is changed then restart drag
                {
                    m_pView = pViewCur;
                    pViewCur->Release();
                    pViewCur = NULL;
                    RestartDrag(point);

                }

                Drag(point);
            }

        }
    }
    catch (...)
    {
        TRACE_EXCEPTION("CTDialog::OnMouseMove")
        _clearfp();
    }

    if(GrsTmp != NULL)
    {
        GrsTmp->Release();
        GrsTmp = NULL;
    }
    if(Gr1 != NULL)
    {
        Gr1->Release();
        Gr1 = NULL;
    }
    if(pPreviewGrs != NULL)
    {
        pPreviewGrs->Release();
        pPreviewGrs = NULL;
    }

}

void CTDialog::ConnectEvents()
{
    HRESULT hRes = S_OK;

    if (m_dwEventConnection != 0)
    {
//		AfxMessageBox("Already connected.");
        return;
    }

    m_pIApplication = NULL;

    try
    {
        hRes = m_pThisTool->get_Application(&m_pIApplication);
        CHECK_HRESULT(hRes)

        if (m_pIApplication == NULL)
        {
    //			AfxMessageBox("Can't get a TurboCAD application!");
                return;
        }

        IDispatch* pUnkEventSink = GetIDispatch(TRUE);

        UpdateData(TRUE);
        COleVariant var((long)m_dwEventMask);
        hRes = m_pIApplication->ConnectEvents(pUnkEventSink,
            &var,
            (long*)&m_dwEventConnection);

        if (FAILED(hRes))
        {
    //		AfxMessageBox("Connection not established.");
            return;
        }
    }
    catch (...)
    {
        TRACE_EXCEPTION("CTDialog::ConnectEvents")
        _clearfp();
    }

}

void CTDialog::DisconectEvents()
{
    if (m_pIApplication == NULL || m_dwEventConnection == 0)
        return;

    try
    {
        HRESULT	hRes = m_pIApplication->DisconnectEvents(m_dwEventConnection);
        if (FAILED(hRes))
        {
    //		AfxMessageBox("Connection not broken.");
            return;
        }
        m_pIApplication->Release(); // possibility problem
        m_pIApplication = NULL;

        m_dwEventConnection = 0;
    }
    catch (...)
    {
        TRACE_EXCEPTION("CTDialog::DisconectEvents")
        _clearfp();
    }

}

BOOL CTDialog::BeginDrag(const CPoint& point)
{
    BOOL bRes = FALSE;
    HRESULT hRes = E_FAIL;
    BoundingBox* Box = NULL;
    IVertex* vMax = NULL;
    IVertex* vMin = NULL;
    double x, y, x1, y1;

    if (m_pView == NULL)
        return bRes;
    try
    {
        VariantClear(&m_dragOutline);
        SAFEARRAYBOUND bound;
        bound.cElements = 0;
        bound.lLbound = 0;
        m_dragOutline.vt = VT_ARRAY|VT_R8;
        m_dragOutline.parray = ::SafeArrayCreate(VT_R8, 1, &bound);
        hRes = m_pDragGraphic->CreateDragOutline(&m_dragOutline);
        CHECK_HRESULT(hRes);

        m_bDragging = TRUE;
        m_pDragGraphic->put_Visible(FALSE);
        VARIANT varState;
        varState.vt = VT_I4;
        varState.lVal = imsiDragBegin;

        hRes = m_pDragGraphic->CalcBoundingBox(NULL, &Box);
        CHECK_HRESULT(hRes)

        hRes = Box->get_Max(&vMax);
        CHECK_HRESULT(hRes)

        hRes = Box->get_Min(&vMin);
        CHECK_HRESULT(hRes)

        hRes = vMax->get_X(&x);
        CHECK_HRESULT(hRes)

        hRes = vMax->get_Y(&y);
        CHECK_HRESULT(hRes)

        hRes = vMin->get_X(&x1);
        CHECK_HRESULT(hRes)

        hRes = vMin->get_Y(&y1);
        CHECK_HRESULT(hRes)

        x = x1 + (x - x1)/2;
        y = y1 + (y - y1)/2;
        hRes = m_pView->ViewToScreen(x, y, &x1, &y1, NULL);
        CHECK_HRESULT(hRes)

        hRes = m_pView->DragOutline(&m_dragOutline, x1, y1, &varState);
        CHECK_HRESULT(hRes)

        varState.lVal = imsiDragContinue;
        hRes = m_pView->DragOutline(&m_dragOutline, point.x, point.y, &varState);
        CHECK_HRESULT(hRes)

        bRes = TRUE;
    }
    catch (...)
    {
        TRACE_EXCEPTION("CTDialog::BeginDrag")
        _clearfp();
    }

    if (vMin != NULL)
    {
        vMin->Release();
        vMin = NULL;
    }
    if (vMax != NULL)
    {
        vMax->Release();
        vMax = NULL;
    }
    if (Box != NULL)
    {
        Box->Release();
        Box = NULL;
    }

    return bRes;
}

BOOL CTDialog::Drag(const CPoint& point)
{
    BOOL bRes = FALSE;
    if (m_pView == NULL)
        return bRes;

    try
    {
        VARIANT varState;
        varState.vt = VT_I4;
        varState.lVal = imsiDragContinue;
        HRESULT hRes = m_pView->DragOutline(&m_dragOutline, point.x, point.y, &varState);
        CHECK_HRESULT(hRes)
        bRes = TRUE;
    }
    catch (...)
    {
        TRACE_EXCEPTION("CTDialog::Drag")
        _clearfp();
    }
    return bRes;
}

BOOL CTDialog::EndDrag(const CPoint& point)
{
    BOOL bRes = FALSE;
    m_bDragging = FALSE;
    IMatrix *pMat = NULL;
    if (m_pView == NULL || m_pDragGraphic == NULL)
        return bRes;

    IDrawing *pIDwg = NULL;
    Properties *pProps = NULL;
    Property *pProp = NULL;

    try
    {
        VARIANT varState;
        varState.vt = VT_I4;
        varState.lVal = imsiDragEnd;
        HRESULT hRes = m_pView->DragOutline(&m_dragOutline, point.x, point.y, &varState);
        CHECK_HRESULT(hRes)

        VariantClear(&m_dragOutline);

        double dx, dy, dz;
        dx = dy = dz = 0;

        double dxWorld, dyWorld, dzWorld;
        dxWorld = dyWorld = dzWorld = 0;

        hRes = m_pView->ScreenToView(point.x, point.y, &dx, &dy);
        CHECK_HRESULT(hRes)

        dxWorld = dx;
        dyWorld = dy;

        VARIANT var;
        var.vt = VT_ERROR;
        var.scode = DISP_E_PARAMNOTFOUND;
//		ImsiSpaceModeType curMode;
// will be available in TCW5.03 decoment this part to give correct position of inserted symbol in model space.

        //	HRESULT hRes = S_OK;
        CString cstrName("TileMode");//# Non-localizable string#
        BSTR bstrName = cstrName.AllocSysString();

        VARIANT varItem;
      ::VariantInit(&varItem);
        varItem.vt = VT_BSTR;
        varItem.bstrVal = bstrName;
        hRes = m_pView->get_Drawing(&pIDwg);
        CHECK_HRESULT(hRes)

        hRes = pIDwg->get_Properties(&pProps);
        CHECK_HRESULT(hRes)

        hRes = pProps->get_Item(&varItem, &pProp);
        CHECK_HRESULT(hRes)

        COleVariant varVal;//(0L);
        hRes = pProp->get_Value(NULL, &varVal);
        CHECK_HRESULT(hRes)

        if(varVal.lVal == 1) //ModelSpace
        {
            hRes = m_pView->ViewToWorld(dx, dy, dz, &dxWorld, &dyWorld, &dzWorld);
            CHECK_HRESULT(hRes)
        }

        hRes = m_pDragGraphic->MoveAbsolute(dxWorld, dyWorld, 0, &var, &var, &var, &pMat);
        CHECK_HRESULT(hRes)

        hRes = m_pDragGraphic->put_Visible(TRUE);
        CHECK_HRESULT(hRes)

        bRes = TRUE;
    }
    catch (...)
    {
        TRACE_EXCEPTION("CTDialog::EndDrag")
        _clearfp();
    }

    if(pMat != NULL)
    {
        pMat->Release();
        pMat = NULL;
    }

    if (m_pDragGraphic != NULL)
    {
        m_pDragGraphic->Release();
        m_pDragGraphic = NULL;
    }

    if (pProp != NULL)
    {
        pProp->Release();
        pProp = NULL;
    }

    if (pProps != NULL)
    {
        pProps->Release();
        pProps = NULL;
    }
    if (pIDwg != NULL)
    {
        pIDwg->Release();
        pIDwg = NULL;
    }

    return bRes;
}

BOOL CTDialog::RestartDrag(const CPoint& point)
{
    try
    {
        m_bDragging = FALSE;
        VARIANT varState;
        varState.vt = VT_I4;
        varState.lVal = imsiDragEnd;
        HRESULT hRes = m_pView->DragOutline(&m_dragOutline, point.x, point.y, &varState);
        CHECK_HRESULT(hRes)

        VariantClear(&m_dragOutline);
        BeginDrag(point);
    }
    catch (...)
    {
        TRACE_EXCEPTION("CTDialog::RestartDrag")
        _clearfp();
    }

    return TRUE;
}

void CTDialog::OnBrowse()
{

    CToolList *pList = (CToolList *)GetDlgItem(IDC_LIST1);
    CViewWnd *pView = (CViewWnd *)GetDlgItem(IDC_PREVIEW);
    CEdit *pPath = (CEdit *) GetDlgItem(IDC_EDITPATH);

    CDirDialog* pDirDlg = new CDirDialog;
    //pDirDlg->m_strTitle = "Select directory contains tcw symbols. ";//# Localizable string#
    pDirDlg->m_strTitle.LoadString(IDS_STRING104);
    pPath->GetWindowText(pDirDlg->m_strSelDir);
    CString strtmp;
    pPath->GetWindowText(strtmp);
    int i = pDirDlg->DoBrowse (m_hWnd);
    if(i == 0)
        return;

    HCURSOR hOC = ::SetCursor(::LoadCursor(NULL,IDC_WAIT));

    if (strtmp != pDirDlg->m_strPath)
    {

        pPath->SetWindowText ((LPCTSTR) pDirDlg->m_strPath);
        pView->ClearAll ();
        pView->Invalidate ();
        pList->RefreshFileList(pDirDlg->m_strPath);
        if(pList->SetCurSel(0) != LB_ERR)
        {

            pList->GetText(0 ,(pList->m_cstrCurSelected));
            pView->CreatePreview();
            pView->DoPreview();

        }
//		else
//		{
//			pList->m_cstrCurSelected = "";
//		}
    }
    ::SetCursor(hOC);

}


Examples - C++ Insert Symbol Tool - TDialog.h

TDialog.h

C++ Insert Symbol Tool Example

#if !defined(AFX_TDIALOG_H__0416A817_839B_11D2_82F6_006052012837__INCLUDED_)
#define AFX_TDIALOG_H__0416A817_839B_11D2_82F6_006052012837__INCLUDED_

#include "Toollist.h"
#include "ViewWnd.h"
#include "InsSymb.h"

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000
// TDialog.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CTDialog dialog

class CTDialog : public CDialog
{
// Construction
public:
    CViewWnd m_wndView;
    View* m_pView;
    IGraphic* m_pDragGraphic;
    Graphics* m_pDragGraphics;
    VARIANT m_dragOutline;
    BOOL EndDrag(const CPoint& point);
    BOOL Drag(const CPoint& point);
    BOOL BeginDrag(const CPoint& point);
    BOOL RestartDrag(const CPoint& point);
    CToolList m_list;
    BOOL m_bDragging;
    BOOL m_FirstClick;
//	RegenMethods* m_pRegMets;
    IApplication* m_pIApplication;
    DWORD m_dwEventMask;
    DWORD m_dwEventConnection;
    void DisconectEvents();
    void ConnectEvents();
    Tool *m_pThisTool;

    //	CTDialog(CWnd* pParent = NULL);   // standard constructor
    CTDialog(CInsSymb* pTool, CWnd* pParent, Tool *pThisTool);   // standard constructor

    // Dialog Data
    //{{AFX_DATA(CTDialog)
    enum { IDD = IDD_DIALOG1 };
        // NOTE: the ClassWizard will add data members here
    //}}AFX_DATA

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CTDialog)
    public:
///	virtual void OnFinalRelease();

    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL
    // Generated OLE dispatch map functions
    //{{AFX_DISPATCH(CTDialog)
        // NOTE - the ClassWizard will add and remove member functions here.
    //}}AFX_DISPATCH

// Implementation
protected:
    CInsSymb *m_pTool;

    // Generated message map functions
    //{{AFX_MSG(CTDialog)
    virtual BOOL OnInitDialog();
    afx_msg void OnClose();
    afx_msg void OnBrowse();
    afx_msg void OnModify();
    afx_msg void OnCheck1();
    afx_msg void OnSysCommand(UINT nID, LPARAM lParam );
    //}}AFX_MSG
///	DECLARE_MESSAGE_MAP()
    // Generated OLE dispatch map functions
    //{{AFX_DISPATCH(CTDialog)
        // NOTE - the ClassWizard will add and remove member functions here.
    //}}AFX_DISPATCH

    DECLARE_MESSAGE_MAP()

    afx_msg void BeforeExit(LPDISPATCH TheApp, BOOL FAR* Cancel);
    afx_msg void DrawingNew(LPDISPATCH WhichDrawing);
    afx_msg void DrawingOpen(LPDISPATCH WhichDrawing);
    afx_msg void DrawingActivate(LPDISPATCH WhichDrawing);
    afx_msg void DrawingDeactivate(LPDISPATCH WhichDrawing);
    afx_msg void DrawingBeforeClose(LPDISPATCH WhichDrawing, BOOL FAR* Cancel);
    afx_msg void DrawingBeforeSave(LPDISPATCH WhichDrawing, BOOL FAR* SaveAs, BOOL FAR* Cancel);
    afx_msg void WindowResize(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow);
    afx_msg void WindowActivate(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow);
    afx_msg void WindowDeactivate(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow);

    afx_msg void MouseDown(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel);
    afx_msg void MouseUp(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, short Button, long Shift, long X, long Y, IMSI_BOOL* pbCancel);
    afx_msg void MouseMove(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, long Shift, long X, long Y, IMSI_BOOL* pbCancel);

    afx_msg void BeforeDoubleClick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel, BOOL FAR* Cancel);
    afx_msg void BeforeRightClick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel, BOOL FAR* Cancel);
    afx_msg void SelectionChange(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Sel);
    afx_msg void CommandBarControlHit(LPDISPATCH WhichControl, BOOL FAR* Cancel);
    afx_msg void CommandBarControlStatus(LPDISPATCH WhichControl);
    afx_msg void RunTool(LPDISPATCH WhichTool);
    afx_msg void PointSnapped(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, long XScreen, long YScreen, LPDISPATCH PointRaw, LPDISPATCH PointSnapped);
    afx_msg void PointPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled);
    afx_msg void RectanglePick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled);
    afx_msg void PolygonPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH Result, BOOL PickWasCanceled);
    afx_msg void ViewBeforeRedraw(LPDISPATCH WhichDrawing, LPDISPATCH WhichView);
    afx_msg void ViewAfterRedraw(LPDISPATCH WhichDrawing, LPDISPATCH WhichView);
    afx_msg void VirtualIntersectionPick(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH PickResult, BOOL WasCanceled);
    afx_msg void CommandBarControlDone(LPDISPATCH WhichControl);
    afx_msg void Drop(LPDISPATCH WhichDrawing, LPDISPATCH WhichView, LPDISPATCH WhichWindow, LPDISPATCH Selection);

    DECLARE_DISPATCH_MAP()

    DECLARE_INTERFACE_MAP()
};

//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_TDIALOG_H__0416A817_839B_11D2_82F6_006052012837__INCLUDED_)


Examples - C++ Insert Symbol Tool - ToolList.cpp

ToolList.cpp

C++ Insert Symbol Tool Example

// ToolList.cpp : implementation file
//

#include "stdafx.h"
#include "InsTool.h"
#include "ToolList.h"
#include "TDialog.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// ToolList

CToolList::CToolList()
{
//	EnableAutomation();
}

CToolList::~CToolList()
{
}

void CToolList::OnFinalRelease()
{
    // When the last reference for an automation object is released
    // OnFinalRelease is called.  The base class will automatically
    // deletes the object.  Add additional cleanup required for your
    // object before calling the base class.

    CListBox::OnFinalRelease();
}

BEGIN_MESSAGE_MAP(CToolList, CListBox)
    //{{AFX_MSG_MAP(CToolList)
    ON_WM_LBUTTONDOWN()
    ON_WM_LBUTTONUP()
    ON_WM_MOUSEMOVE()
    ON_CONTROL_REFLECT(LBN_SELCHANGE, OnSelchange)
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// ToolList message handlers

void CToolList::RefreshFileList(CString path)
{
    struct _finddata_t c_file;
    long hFile;
    hFile = 0;
//	int i = _chdir("c:\\SYMBOLS");  // the directory that contains symbols.
    int i = _chdir(path);  // the directory that contains symbols.
    ResetContent();
    m_cstrCurSelected = "";
    /* Find first .c file in current directory */
    if (i == 0)
    {
        if( (hFile = _findfirst( "*.tcw", &c_file )) != -1L )//# Non-localizable string#
        {
            /* Find the rest of the .c files */
            AddString(c_file.name); //add first file to the list

            while( _findnext( hFile, &c_file ) == 0 )
            {
                AddString(c_file.name);

            }
            _findclose( hFile );
        }
//		else
//			MessageBox("Selected directory doesn't contain *.tcw files", "Warning", MB_OK);

    }

}

void CToolList::OnLButtonDown(UINT nFlags, CPoint point)
{
    // TODO: Add your message handler code here and/or call default
    CListBox::OnLButtonDown(nFlags, point);
    BOOL ret;

    m_LB_DOWNpoint.x = point.x;
    m_LB_DOWNpoint.y = point.y;

    CString cstrSelected = "";
    CListBox *pList = (CListBox *) (GetParent()->GetDlgItem(IDC_LIST1));

    UINT index = ItemFromPoint(point, ret);
    if (ret == FALSE)
    {
        m_drag = TRUE;
        GetText(index, cstrSelected);
    }
    if (m_cstrCurSelected != cstrSelected && cstrSelected != "") // check if the current selection is changed
    {
        BeginWaitCursor();
        CViewWnd *pView = (CViewWnd *) (((CTDialog*)GetParent())->GetDlgItem(IDC_PREVIEW));
        pView->ClearAll();
        int index = pList->GetCurSel();

        BOOL a = FALSE;

        a = pView->CreatePreview();
        if(a == FALSE)
            return;

        a = FALSE;
        a = pView->DoPreview();
        if (a = FALSE)
        {
            CString szMess;
            CString szCap;
            szMess.LoadString(IDS_STRING105);
            szCap.LoadString(IDS_STRING106);
            //MessageBox("The drawing have Brush styles or Line styles different from default. This sample can't work with such files", "ERROR!", MB_OK);//# Localizable string#
            MessageBox(LPCTSTR(szMess),LPCTSTR(szCap), MB_OK);
            pList->DeleteString(index);
        }
        m_cstrCurSelected = cstrSelected;
        pView->Invalidate();
        EndWaitCursor();
    }

}

void CToolList::OnLButtonUp(UINT nFlags, CPoint point)
{
    // TODO: Add your message handler code here and/or call default

    CListBox::OnLButtonUp(nFlags, point);
    m_drag = FALSE;

    CPoint Pt = point;
    ClientToScreen(&Pt);
    CWnd *pClickWNd = WindowFromPoint(Pt);

    if(pClickWNd && pClickWNd != this)
    {
        pClickWNd->ScreenToClient(&Pt);
        pClickWNd->PostMessage(WM_LBUTTONUP, nFlags, MAKELONG(Pt.x, Pt.y));
        SetCursor(m_OldCursor);
        ShowCursor(TRUE);
        return;

    }
    else
    {
        SetCursor(m_OldCursor);
        ShowCursor(TRUE);
//		((CTDialog*)GetParent())->DisconectEvents();

    }

}

void CToolList::OnMouseMove(UINT nFlags, CPoint point)
{
    // TODO: Add your message handler code here and/or call default

    if(nFlags & MK_LBUTTON)
    {

        int dx = m_LB_DOWNpoint.x - point.x;
        int dy = m_LB_DOWNpoint.y - point.y;
        CPoint Pt = point;

        if((abs(dx) > 1 || abs(dy) > 1) && m_drag)
        {
// if dragging
            if (((CTDialog*)GetParent())->m_dwEventConnection == 0)
            {
                ((CTDialog*)GetParent())->ConnectEvents();
            }

                m_OldCursor = GetCursor();
                m_NewCursor = LoadCursor(AfxGetInstanceHandle( ), MAKEINTRESOURCE(IDC_CURSOR1));
                SetCursor(m_NewCursor);
                ShowCursor(TRUE);
                m_drag = FALSE;
                m_LB_DOWNpoint.x = -1;
                m_LB_DOWNpoint.y = -1;
                ((CTDialog*)GetParent())->m_FirstClick = TRUE;
                return;

        }

        ClientToScreen(&Pt);
        CWnd *pClickWNd = WindowFromPoint(Pt);

        if(pClickWNd && pClickWNd != this)
        {
            pClickWNd->ScreenToClient(&Pt);
            pClickWNd->PostMessage(WM_MOUSEMOVE, nFlags, MAKELONG(Pt.x, Pt.y));
        }

    }

}

void CToolList::OnSelchange()

{
    // TODO: Add your control notification handler code here

    CListBox *pList = (CListBox *) (GetParent()->GetDlgItem(IDC_LIST1));
    int index = pList->GetCurSel();
    CString cstrSelected;
    HCURSOR hOC = ::SetCursor(::LoadCursor(NULL,IDC_WAIT));

    pList->GetText(index, cstrSelected);

    if (m_cstrCurSelected != cstrSelected && cstrSelected != "")
    {
        CViewWnd *pView = (CViewWnd *) (((CTDialog*)GetParent())->GetDlgItem(IDC_PREVIEW));
        pView->ClearAll();

        BOOL a = FALSE;

        a = pView->CreatePreview();
        if(a == FALSE)
            return;

        a = FALSE;
        a = pView->DoPreview();
        if (a = FALSE)
        {
            CString szMess;
            CString szCap;
            szMess.LoadString(IDS_STRING105);
            szCap.LoadString(IDS_STRING106);
            //MessageBox("The drawing have Brush styles or Line styles different from default. This sample can't work with such files", "ERROR!", MB_OK);//# Localizable string#
            MessageBox(LPCTSTR(szMess),LPCTSTR(szCap), MB_OK);
            pList->DeleteString(index);
        }
        m_cstrCurSelected = cstrSelected;
    }

    ::SetCursor(hOC);

}


Examples - C++ Insert Symbol Tool - ToolList.h

ToolList.h

C++ Insert Symbol Tool Example

#if !defined(AFX_TOOLLIST_H__9EC46045_842F_11D2_82F7_006052012837__INCLUDED_)
#define AFX_TOOLLIST_H__9EC46045_842F_11D2_82F7_006052012837__INCLUDED_

#if _MSC_VER >= 1000
#pragma once
#endif // _MSC_VER >= 1000
// ToolList.h : header file
//
#include <io.h>
#include <direct.h>
/////////////////////////////////////////////////////////////////////////////
// ToolList window

class CToolList : public CListBox
{
// Construction
public:
    CToolList();

// Attributes
public:

// Operations
public:

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CToolList)
    public:
    virtual void OnFinalRelease();
    //}}AFX_VIRTUAL

// Implementation
public:
    CString m_cstrCurSelected;
    BOOL m_drag;
    CPoint m_LB_DOWNpoint;
    void RefreshFileList(CString path);
    virtual ~CToolList();

    // Generated message map functions
protected:
    HCURSOR m_OldCursor;
    HCURSOR m_NewCursor;
    //{{AFX_MSG(CToolList)
    afx_msg void OnLButtonDown(UINT nFlags, CPoint point);
    afx_msg void OnLButtonUp(UINT nFlags, CPoint point);
    afx_msg void OnMouseMove(UINT nFlags, CPoint point);
    afx_msg void OnSelchange();
    //}}AFX_MSG

    DECLARE_MESSAGE_MAP()
};

/////////////////////////////////////////////////////////////////////////////

//{{AFX_INSERT_LOCATION}}
// Microsoft Developer Studio will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_TOOLLIST_H__9EC46045_842F_11D2_82F7_006052012837__INCLUDED_)


Examples - C++ Insert Symbol Tool - ViewWnd.cpp

ViewWnd.cpp

C++ Insert Symbol Tool Example

// ViewWnd.cpp : implementation file
//

#include "stdafx.h"
#include "tcintf.h"
#include "InsTool.h"
#include "InsSymb.h"
#include "ViewWnd.h"
#include "TDialog.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CViewWnd

//CViewWnd::CViewWnd(CInsSymb* pTool)
CViewWnd::CViewWnd(CInsSymb* pTool)
{
    EnableAutomation();
    m_FirstStart = TRUE;
    m_pIApp = NULL;
    m_pDwgs = NULL;
    m_pPreviewDrawing = NULL;
    m_pPreviewGrs = NULL;
    m_pPreviewView = NULL;
    m_pViewsCol = NULL;
    m_hCurActDr = NULL;

    {
        m_pTool = pTool;
    }
}

CViewWnd::~CViewWnd()
{
}

void CViewWnd::OnFinalRelease()
{
    // When the last reference for an automation object is released
    // OnFinalRelease is called.  The base class will automatically
    // deletes the object.  Add additional cleanup required for your
    // object before calling the base class.

    CWnd::OnFinalRelease();
}

BEGIN_MESSAGE_MAP(CViewWnd, CWnd)
    //{{AFX_MSG_MAP(CViewWnd)
    ON_WM_PAINT()
    ON_WM_ERASEBKGND()
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

BEGIN_DISPATCH_MAP(CViewWnd, CWnd)
    //{{AFX_DISPATCH_MAP(CViewWnd)
        // NOTE - the ClassWizard will add and remove mapping macros here.
    //}}AFX_DISPATCH_MAP
END_DISPATCH_MAP()

// Note: we add support for IID_IViewWnd to support typesafe binding
//  from VBA.  This IID must match the GUID that is attached to the
//  dispinterface in the .ODL file.

// {4B1AA263-851C-11D2-8BEA-00403338C504}
static const IID IID_IViewWnd =
{ 0x4b1aa263, 0x851c, 0x11d2, { 0x8b, 0xea, 0x0, 0x40, 0x33, 0x38, 0xc5, 0x4 } };
//const CLSID CLSID_XApplication = {0x6A481801,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

const IID IID_ITcApp =  {0x6A481200,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
const IID IID_ITcDrawing = {0x6A481201,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};
//const IID IID_IDrawing = {0x6A481107,0xE531,0x11CF,{0xA1,0x15,0x00,0xA0,0x24,0x15,0x8D,0xAF}};

BEGIN_INTERFACE_MAP(CViewWnd, CWnd)
    INTERFACE_PART(CViewWnd, IID_IViewWnd, Dispatch)
END_INTERFACE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CViewWnd message handlers

BOOL CViewWnd::CreatePreview()
{
    HRESULT hRes = E_FAIL;
    COleVariant varType((const long)imsiPolyline);
    COleVariant varOptional(varMissing);

    try
    {
        ClearAll();
        HMODULE	hDBAPI = NULL;// = GetModuleHandle(DBAPI50);
        hDBAPI = GetModuleHandle(DBAPI70);
        if (hDBAPI == NULL)
        {
            hDBAPI = GetModuleHandle(DBAPI60);

            if (hDBAPI == NULL)
            {
                hDBAPI = GetModuleHandle(DBAPI50);
            }
        }

        if (hDBAPI == NULL)
            return FALSE;
        else
        m_pfGetApp = (APPGETCURRENTAPP)GetProcAddress(hDBAPI, _T("AppGetCurrentApp"));
        if (m_pfGetApp == NULL)
            return FALSE;

        m_lApp = (*m_pfGetApp)();
        if (m_lApp == 0)
            return FALSE;

        m_pfFileOpen = (GRAPHICFILEOPENEX)GetProcAddress(hDBAPI, _T("GraphicFileOpenEx"));
        if (m_pfFileOpen == NULL)
            return FALSE;

        m_pfAppDwgNew = (APPDRAWINGNEWEX)GetProcAddress(hDBAPI, _T("AppDrawingNewEx"));
        if (m_pfAppDwgNew == NULL)
            return FALSE;

        BOOL i;
        i = TRUE;
        COleVariant varItem = (0L);
        long nDrawings = 0;

        m_lDwg = (*m_pfAppDwgNew)(m_lApp, i, NULL, NULL);

        hRes = ((CTDialog*)GetParent())->m_pThisTool->get_Application(&m_pIApp);
        CHECK_HRESULT(hRes)

        hRes = m_pIApp->get_Drawings(&m_pDwgs);
        CHECK_HRESULT(hRes)

        hRes = m_pDwgs->get_Count(&nDrawings);
        CHECK_HRESULT(hRes)

        varItem = nDrawings - 1L;

        hRes = m_pDwgs->get_Item(&varItem, &m_pPreviewDrawing);
        CHECK_HRESULT(hRes)

        hRes = m_pPreviewDrawing->get_Views(&m_pViewsCol);
        CHECK_HRESULT(hRes)

        HWND hWnd = ::GetDlgItem(GetParent()->m_hWnd, IDC_PREVIEW);
        COleVariant varHwnd((long)hWnd);
        long nViews = 0;

        hRes = m_pViewsCol->Add(&varHwnd, &varOptional, &m_pPreviewView );
        CHECK_HRESULT(hRes)

        hRes = m_pPreviewView->put_Update(FALSE);
        CHECK_HRESULT(hRes)

        hRes = m_pPreviewView->put_MappingMode(MM_TEXT);
        CHECK_HRESULT(hRes)

        hRes = m_pPreviewView->put_FixedAspectRatio(TRUE);
        CHECK_HRESULT(hRes)

        hRes = m_pPreviewView->put_Margins(FALSE);
        CHECK_HRESULT(hRes)

        CViewWnd *pPreview = (CViewWnd *) (((CTDialog*)GetParent())->GetDlgItem(IDC_PREVIEW));

        AFX_MANAGE_STATE(m_pTool->m_pTCState);

        CRect rcBounds;
        pPreview->GetClientRect(&rcBounds);
        pPreview->Invalidate();

        hRes = m_pPreviewView->put_ScreenLeft(rcBounds.left);
        CHECK_HRESULT(hRes)

        hRes = m_pPreviewView->put_ScreenTop(rcBounds.top);
        CHECK_HRESULT(hRes)

        hRes = m_pPreviewView->put_ScreenWidth(rcBounds.Width());
        CHECK_HRESULT(hRes)

        hRes = m_pPreviewView->put_ScreenHeight(rcBounds.Height());
        CHECK_HRESULT(hRes)

        hRes = m_pPreviewView->ZoomToExtents();
        CHECK_HRESULT(hRes)

        VariantClear(&varType);
        VariantClear(&varOptional);

    }
    catch (...)
    {

        TRACE_EXCEPTION("CViewWnd::CreatePreview")
        ClearAll();
        _clearfp();

    }
    if(m_pIApp != NULL)
    {
        m_pIApp->Release();
        m_pIApp = NULL;
    }
    return TRUE;
}

BOOL CViewWnd::DoPreview()
{
    HRESULT hRes = E_FAIL;
    BOOL bRes = FALSE;
//	COleVariant varType((const long)imsiPolyline);
    COleVariant varType((const long)imsiGroup);
    COleVariant varOptional(varMissing);
    CString cstrError;
    BOOL curMode;
    BOOL i;
    i = TRUE;
    long IDwg1 = 0;
    COleVariant varItem = (0L);
    long nDrawings = 0;
    IDrawing* pTmpDwg = NULL;

    Properties *pProps = NULL;
    Property *pProp = NULL;
    Properties *pProps1 = NULL;
    Property *pProp1 = NULL;
    CMerge merge;
    IGraphic* pIGrTmp = NULL;
    IGraphic* pIGrTmp1 = NULL;

    ITcDrawing* pITcDr = NULL;
    ITcApp* pTcApp = NULL;
    IDrawing* pIDwg = NULL;

    try
    {
        CButton *pCheckBox = (CButton *) (GetParent()->GetDlgItem(IDC_CHECK1));

        CToolList *pList = (CToolList *) (GetParent()->GetDlgItem(IDC_LIST1));

        int index = pList->GetCurSel();

        pList->GetText(index, m_selected);

        IDwg1 = (*m_pfAppDwgNew)(m_lApp, i, NULL, NULL);

        hRes = m_pDwgs->get_Count(&nDrawings);
        CHECK_HRESULT(hRes)

        varItem = nDrawings - 1L;

        hRes = m_pDwgs->get_Item(&varItem, &pTmpDwg);
        CHECK_HRESULT(hRes)

        AFX_MANAGE_STATE(m_pTool->m_pTCState);

        DWORD dwRes = (*m_pfFileOpen)(0, IDwg1, m_lApp, (LPTSTR)(LPCSTR)m_selected, NULL, cstrError.GetBuffer(256), 255,  GF_OPENMODE, 0, NULL );

        if (dwRes == NULL)
            return FALSE;

        CString cstrName("TileMode");//# Non-localizable string#
        BSTR bstrName = cstrName.AllocSysString();

      ::VariantInit(&varItem);
        varItem.vt = VT_BSTR;
        varItem.bstrVal = bstrName;

        hRes = pTmpDwg->get_Properties(&pProps);
        CHECK_HRESULT(hRes)

        hRes = pProps->get_Item(&varItem, &pProp);
        CHECK_HRESULT(hRes)

        hRes = m_pPreviewDrawing->get_Properties(&pProps1);
        CHECK_HRESULT(hRes)

        hRes = pProps1->get_Item(&varItem, &pProp1);
        CHECK_HRESULT(hRes)

        COleVariant varVal;//(0L);
        varVal.vt = VT_I2;

        pProp->get_Value(NULL, &varVal);
        long dd = varVal.iVal;

        if (varVal.iVal == 1)
        {
            curMode = 1;//imsiModelSpace;
        }
        else
        {
            curMode = 0;//imsiPaperSpace;

        }

// switch the Preview drawing and temp drawing to paper space.
        varVal.iVal = 0;
        hRes = pProp1->put_Value(NULL, &varVal);
        CHECK_HRESULT(hRes)

        hRes = pProp->put_Value(NULL, &varVal);
        CHECK_HRESULT(hRes)

        BOOL bGrsOnly;
        bGrsOnly = FALSE;
// merge the paper space graphics collection and blocks, styles, layers...
        hRes = merge.Init(pTmpDwg, m_pPreviewDrawing, FALSE);
        CHECK_HRESULT(hRes)

        hRes = merge.Run(&pIGrTmp, bGrsOnly);
        CHECK_HRESULT(hRes)

// switch the Preview drawing and temp drawing to model space.

        varVal.iVal = 1;

        hRes = pProp1->put_Value(NULL, &varVal);
        CHECK_HRESULT(hRes)

        hRes = pProp->put_Value(NULL, &varVal);
        CHECK_HRESULT(hRes)

        // merge the model space graphics collection

//		bGrsOnly = TRUE;
        bGrsOnly = FALSE;
        hRes = merge.Init(pTmpDwg, m_pPreviewDrawing, FALSE);
        CHECK_HRESULT(hRes)

        hRes = merge.Run(&pIGrTmp1, bGrsOnly);
        CHECK_HRESULT(hRes)

// set the space mode for Preview drawing the same like in file that is open.
        if (curMode == 0) //imsiPaperSpace
        {
            varVal.iVal = 0;

            hRes = pProp1->put_Value(NULL, &varVal);
            CHECK_HRESULT(hRes)

        }
        else
        {

            //	curMode = imsiModelSpace;
            varVal.iVal = 1;

            hRes = pProp1->put_Value(NULL, &varVal);
            CHECK_HRESULT(hRes)

        }

//		hRes = ((CTDialog*)GetParent())->m_pRegMets->get_Application(&m_pIApp);
//		CHECK_HRESULT(hRes)

        hRes = m_pPreviewDrawing->get_Application(&m_pIApp);
        CHECK_HRESULT(hRes)

        hRes = m_pIApp->QueryInterface(IID_ITcApp, (void **) &pTcApp);
        CHECK_HRESULT(hRes)

        hRes = pTcApp->GetActiveDrawing(&pITcDr);
        CHECK_HRESULT(hRes)

        hRes = pITcDr->QueryInterface(IID_IDrawing, (void **) &pIDwg);
        CHECK_HRESULT(hRes)

        hRes = pIDwg->get__Handle((long*)&m_hCurActDr);
        CHECK_HRESULT(hRes)

        if (pProp != NULL)
        {
            pProp->Release();
            pProp = NULL;
        }

        if (pProps != NULL)
        {
            pProps->Release();
            pProps = NULL;
        }

        if(pIGrTmp !=NULL)
        {
            pIGrTmp->Release();
            pIGrTmp = NULL;
        }

        COleVariant varOptional(varMissing);
        pTmpDwg->Close(varOptional, varOptional, varOptional);

        if (m_hCurActDr != NULL)
        {
            hRes = m_pIApp->QueryInterface(IID_ITcApp, (void **) &pTcApp);
            CHECK_HRESULT(hRes)

            hRes = pTcApp->SetActiveDrawing(m_hCurActDr, NULL);
            CHECK_HRESULT(hRes)

            m_hCurActDr = NULL;
        }

        hRes = m_pPreviewView->ZoomToExtents();
        CHECK_HRESULT(hRes)
/*
        hRes = m_pPreviewView->Refresh();
        CHECK_HRESULT(hRes)
*/
        if(pCheckBox == NULL)
            return FALSE;

        if (curMode == 1) //imsiModelSpace
            pCheckBox->SetCheck(1);

        else
            pCheckBox->SetCheck(0);

        bRes = TRUE;

    }
    catch (...)
    {
        _clearfp();
        TRACE_EXCEPTION("CViewWnd::DoPreview")
        hRes = E_FAIL;

    }

    if(pIDwg !=NULL)
    {
        pIDwg->Release();
        pIDwg = NULL;
    }

    if(pITcDr != NULL)
    {
        pITcDr->Release();
        pITcDr = NULL;
    }
    if(pTcApp != NULL)
    {
        pTcApp->Release();
        pTcApp = NULL;
    }

/*
    if(pIGrTmp1 !=NULL)
    {
        pIGrTmp1->Release();
        pIGrTmp1 = NULL;
    }
*/
/*
    if (pProp != NULL)
    {
        pProp->Release();
        pProp = NULL;
    }

    if (pProps != NULL)
    {
        pProps->Release();
        pProps = NULL;
    }

    if(pIGrTmp !=NULL)
    {
        pIGrTmp->Release();
        pIGrTmp = NULL;
    }
*/
    if (pProp1 != NULL)
    {
        pProp1->Release();
        pProp1 = NULL;
    }
    if (pProps1 != NULL)
    {
        pProps1->Release();
        pProps1 = NULL;
    }

    if(pTmpDwg != NULL)
    {
        pTmpDwg->Release();
        pTmpDwg = NULL;
    }
    if(pTcApp != NULL)
    {
        pTcApp->Release();
        pTcApp = NULL;
    }
    if(m_pIApp != NULL)
    {
        m_pIApp->Release();
        m_pIApp = NULL;
    }

    return bRes;

}

void CViewWnd::RefreshList()
{

}

void CViewWnd::Clear()
{
    Invalidate();
}

void CViewWnd::ClearAll()
{
    try
    {

        if (m_pPreviewGrs != NULL)
        {
            m_pPreviewGrs->Release();
            m_pPreviewGrs = NULL;

        }
        if (m_pPreviewView != NULL)
        {
            m_pPreviewView->Delete();
            m_pPreviewView->Release();
            m_pPreviewView = NULL;

        }
        if (m_pViewsCol != NULL)
        {
            m_pViewsCol->Release();
            m_pViewsCol = NULL;

        }
        if (m_pPreviewDrawing != NULL)
        {

            COleVariant varOptional(varMissing);
            HRESULT hRes = m_pPreviewDrawing->Close(varOptional, varOptional, varOptional);
            CHECK_HRESULT(hRes)
            m_pPreviewDrawing->Release();
            m_pPreviewDrawing = NULL;
        }

        m_FirstStart = TRUE;
    }

    catch (...)
    {
        _clearfp();
        TRACE_EXCEPTION("CViewWnd::ClearAll")
    }

    if (m_pDwgs != NULL)
    {
        m_pDwgs->Release();
        m_pDwgs = NULL;
    }

    if (m_pIApp != NULL)
    {
        m_pIApp->Release();
        m_pIApp = NULL;
    }

}

void CViewWnd::OnPaint()
{
    CPaintDC dc(this); // device context for painting

    // TODO: Add your message handler code here
    if (m_pPreviewView == NULL)
        return;

    // Force redraw of view window
    try
    {
        HRESULT hRes = m_pPreviewView->Refresh();
        CHECK_HRESULT(hRes)

    }
    catch (...)
    {
        _clearfp();
        TRACE_EXCEPTION("CViewWnd::Paint")
    }

    // Do not call CWnd::OnPaint() for painting messages
}

BOOL CViewWnd::OnEraseBkgnd(CDC* pDC)
{
    // TODO: Add your message handler code here and/or call default
    CRect rect;
    GetClientRect(rect);
    pDC->FillSolidRect(rect, ::GetSysColor(COLOR_WINDOW));
    return TRUE;

//	return CWnd::OnEraseBkgnd(pDC);
}


Examples - C++ Insert Symbol Tool - ViewWnd.h

ViewWnd.h

C++ Insert Symbol Tool Example

#if !defined(AFX_VIEWWND_H__4B1AA264_851C_11D2_8BEA_00403338C504__INCLUDED_)
#define AFX_VIEWWND_H__4B1AA264_851C_11D2_8BEA_00403338C504__INCLUDED_

#include "StdAfx.h"	// Added by ClassView
#if _MSC_VER > 1000
#pragma once
#endif // _MSC_VER > 1000
// ViewWnd.h : header file
//
#include "InsSymb.h"

/////////////////////////////////////////////////////////////////////////////
// CViewWnd window
#define GF_OPENMODE 35

class CViewWnd : public CWnd
{
// Construction
public:
    CViewWnd(CInsSymb* pTool);
    CViewWnd();

// Attributes
public:

// Operations
public:

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CViewWnd)
    public:
    virtual void OnFinalRelease();
    //}}AFX_VIRTUAL

// Implementation
public:
    long m_lDwg;
    Drawings* m_pDwgs;
    IApplication* m_pIApp;
    Views* m_pViewsCol;

    Graphics* m_pPreviewGrs;
    long m_lApp;
    CString m_selected;
    BOOL m_FirstStart;
    void ClearAll();
    void Clear();
    void RefreshList();
    BOOL DoPreview();
    BOOL CreatePreview();
    View* m_pPreviewView;
    IDrawing* m_pPreviewDrawing;
//	hDrawing* m_pCurActDr;
    long* m_hCurActDr;
    // get current active drawing

    virtual ~CViewWnd();

    // Generated message map functions
protected:
    CInsSymb *m_pTool;
    APPDRAWINGNEWEX m_pfAppDwgNew;
    APPGETCURRENTAPP m_pfGetApp;
    GRAPHICFILEOPENEX m_pfFileOpen;
    //{{AFX_MSG(CViewWnd)
    afx_msg void OnPaint();
    afx_msg BOOL OnEraseBkgnd(CDC* pDC);
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
    // Generated OLE dispatch map functions
    //{{AFX_DISPATCH(CViewWnd)
        // NOTE - the ClassWizard will add and remove member functions here.
    //}}AFX_DISPATCH
    DECLARE_DISPATCH_MAP()
    DECLARE_INTERFACE_MAP()
};

/////////////////////////////////////////////////////////////////////////////

//{{AFX_INSERT_LOCATION}}
// Microsoft Visual C++ will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_VIEWWND_H__4B1AA264_851C_11D2_8BEA_00403338C504__INCLUDED_)


Examples - C++ Wizard - Begin.cpp

Begin.cpp

C++ Wizard Example

// Begin.cpp : implementation file
//

#include "stdafx.h"
#include "resource.h"
#include "Begin.h"
#include "PaperSpaceWizard.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CBegin property page

IMPLEMENT_DYNCREATE(CBegin, CPropertyPage)

CBegin::CBegin() : CPropertyPage(CBegin::IDD)
{
    //{{AFX_DATA_INIT(CBegin)
        // NOTE: the ClassWizard will add member initialization here
    //}}AFX_DATA_INIT
}

CBegin::~CBegin()
{
}

void CBegin::DoDataExchange(CDataExchange* pDX)
{
    CPropertyPage::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CBegin)
        // NOTE: the ClassWizard will add DDX and DDV calls here
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CBegin, CPropertyPage)
    //{{AFX_MSG_MAP(CBegin)
        // NOTE: the ClassWizard will add message map macros here
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CBegin message handlers

BOOL CBegin::OnSetActive()
{

//	CPropertySheet* pSheet = (CPropertySheet*)GetParent();
    CPaperSpaceWizard* pSheet = (CPaperSpaceWizard*)GetParent();
    ASSERT_KINDOF(CPropertySheet, pSheet);
//	pSheet->SetWizardButtons(PSWIZB_NEXT);

    CEdit *pEdit = (CEdit *) GetDlgItem(IDC_EDITPSNAME);
    pEdit->SetWindowText (pSheet->m_PSInfo->cstrPSpaceName);

    return CPropertyPage::OnSetActive();
}

LRESULT CBegin::OnWizardNext()
{
    // TODO: Add your specialized code here and/or call the base class
    HRESULT hRes = E_FAIL;
    CString cstrTmp;
    CString cstrErr;
    COleVariant varName;
    varName.vt = VT_BSTR;
    PaperSpace *pPs = NULL;

    try
    {

        CPaperSpaceWizard* pSheet = (CPaperSpaceWizard*)GetParent();
        CEdit *pEdit = (CEdit *) GetDlgItem(IDC_EDITPSNAME);
        pEdit->GetWindowText(cstrTmp);
        varName.bstrVal  = cstrTmp.AllocSysString ();
        hRes = pSheet->m_pPss->get_Item(&varName, &pPs);
        if(FAILED(hRes))
        {
            pSheet->m_PSInfo->cstrPSpaceName = cstrTmp;
            cstrTmp.Empty ();
            return CPropertyPage::OnWizardNext();
        }
        cstrErr.LoadString (IDS_ERRDUPLICATEPS);
        AfxMessageBox(cstrErr);
        pEdit->SetFocus ();
        pEdit->SetSel(0, strlen(cstrTmp), FALSE);

    }
    catch(...)
    {
        TRACE("CBegin::OnWizardNext");
    }
    RELEASE(pPs)
    return CPropertyPage::OnSetActive();
}


Examples - C++ Wizard - Begin.h

Begin.h

C++ Wizard Example

#if !defined(AFX_BEGIN_H__FC542F57_E7DD_4CBA_8230_85AAD08B0023__INCLUDED_)
#define AFX_BEGIN_H__FC542F57_E7DD_4CBA_8230_85AAD08B0023__INCLUDED_

#if _MSC_VER > 1000
#pragma once
#endif // _MSC_VER > 1000
// Begin.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CBegin dialog

class CBegin : public CPropertyPage
{
    DECLARE_DYNCREATE(CBegin)

// Construction
public:
    CBegin();
    ~CBegin();

// Dialog Data
    //{{AFX_DATA(CBegin)
    enum { IDD = IDD_BEGIN };
        // NOTE - ClassWizard will add data members here.
        //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_DATA

// Overrides
    // ClassWizard generate virtual function overrides
    //{{AFX_VIRTUAL(CBegin)
    public:
    virtual BOOL OnSetActive();
    virtual LRESULT OnWizardNext();
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:
    // Generated message map functions
    //{{AFX_MSG(CBegin)
        // NOTE: the ClassWizard will add member functions here
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()

};

//{{AFX_INSERT_LOCATION}}
// Microsoft Visual C++ will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_BEGIN_H__FC542F57_E7DD_4CBA_8230_85AAD08B0023__INCLUDED_)


Examples - C++ Wizard - PaperOrientation.cpp

PaperOrientation.cpp

C++ Wizard Example

// PaperOrientation.cpp : implementation file
//

#include "stdafx.h"
#include "resource.h"
#include "PaperOrientation.h"
#include "PaperSpaceWizard.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CPaperOrientation property page

IMPLEMENT_DYNCREATE(CPaperOrientation, CPropertyPage)

CPaperOrientation::CPaperOrientation() : CPropertyPage(CPaperOrientation::IDD)
{
    //{{AFX_DATA_INIT(CPaperOrientation)
        // NOTE: the ClassWizard will add member initialization here
    //}}AFX_DATA_INIT
}

CPaperOrientation::~CPaperOrientation()
{
}

void CPaperOrientation::DoDataExchange(CDataExchange* pDX)
{
    CPropertyPage::DoDataExchange(pDX);
    //{{AFX_DATA_MAP(CPaperOrientation)
        // NOTE: the ClassWizard will add DDX and DDV calls here
    //}}AFX_DATA_MAP
}

BEGIN_MESSAGE_MAP(CPaperOrientation, CPropertyPage)
    //{{AFX_MSG_MAP(CPaperOrientation)
    ON_BN_CLICKED(IDC_PORIENTATIONP, OnPorientationp)
    ON_BN_CLICKED(IDC_PORIENTATIONL, OnPorientationl)
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CPaperOrientation message handlers

BOOL CPaperOrientation::OnSetActive()
{
//	CPropertySheet* pSheet = (CPropertySheet*)GetParent();
    CPaperSpaceWizard* pSheet = (CPaperSpaceWizard*)GetParent();

    ASSERT_KINDOF(CPropertySheet, pSheet);
    pSheet->SetWizardButtons( PSWIZB_BACK | PSWIZB_FINISH);
    LPTSTR IDB;
    CButton *pRadioB = (CButton *) GetDlgItem(IDC_PORIENTATIONL);
    CButton *pRadioB1 = (CButton *) GetDlgItem(IDC_PORIENTATIONP);
    CStatic *pPaperPreview = (CStatic *) GetDlgItem(IDC_PAPERPREVIEW);

    if (pSheet->m_PSInfo->bPaperOrientation == 0)
    {
        IDB = MAKEINTRESOURCE(IDI_ICONP);
        pRadioB1->SetCheck(1);
        pRadioB->SetCheck(0);
    }
    else
    {
        IDB = MAKEINTRESOURCE(IDI_ICONL);
        pRadioB1->SetCheck(0);
        pRadioB->SetCheck(1);

    }
    HICON pIcon = ::LoadIcon (AfxGetResourceHandle(), IDB);
    pPaperPreview->SetIcon (pIcon);
//	int i = DeleteObject(pBmp);

/*
    if (pSheet->m_PSInfo.bPaperOrientation == 0)
        CPaperOrientation::OnPorientationp ();
    else
        CPaperOrientation::OnPorientationl ();
*/
    return CPropertyPage::OnSetActive();
}

void CPaperOrientation::OnPorientationp()
{
    // TODO: Add your control notification handler code here
    LPTSTR IDB;

    CButton *pRadioB = (CButton *) GetDlgItem(IDC_PORIENTATIONL);
    pRadioB->SetCheck(0);
    CButton *pRadioB1 = (CButton *) GetDlgItem(IDC_PORIENTATIONP);
    pRadioB1->SetCheck(1);

    CStatic *pPaperPreview = (CStatic *) GetDlgItem(IDC_PAPERPREVIEW);
    IDB = MAKEINTRESOURCE(IDI_ICONP);
    HICON pIcon = ::LoadIcon (AfxGetResourceHandle(), IDB);
    pPaperPreview->SetIcon (pIcon);
    int i = DeleteObject(pIcon);
    CPaperSpaceWizard* pSheet = (CPaperSpaceWizard*)GetParent();
    pSheet->m_PSInfo->bPaperOrientation = 0;
}

void CPaperOrientation::OnPorientationl()
{
    // TODO: Add your control notification handler code here
    LPTSTR IDB;
    CButton *pRadioB = (CButton *) GetDlgItem(IDC_PORIENTATIONP);
    pRadioB->SetCheck(0);

    CButton *pRadioB1 = (CButton *) GetDlgItem(IDC_PORIENTATIONL);
    pRadioB1->SetCheck(1);

    CStatic *pPaperPreview = (CStatic *) GetDlgItem(IDC_PAPERPREVIEW);

    IDB = MAKEINTRESOURCE(IDI_ICONL);
//	HBITMAP pBmp = ::LoadBitmap(AfxGetResourceHandle(), IDB);
    HICON pIcon = ::LoadIcon (AfxGetResourceHandle(), IDB);
    pPaperPreview->SetIcon (pIcon);
    int i = DeleteObject(pIcon);
    CPaperSpaceWizard* pSheet = (CPaperSpaceWizard*)GetParent();
    pSheet->m_PSInfo->bPaperOrientation = 1;

}

BOOL CPaperOrientation::OnWizardFinish()
{
    // TODO: Add your specialized code here and/or call the base class

    CPaperSpaceWizard* pSheet = (CPaperSpaceWizard*)GetParent();
    BSTR bstrPsName;
    HRESULT hRes = E_FAIL;
    PaperSpace *pPs = NULL;
    IDispatch *pDisp = NULL;
    try
    {
        bstrPsName = pSheet->m_PSInfo->cstrPSpaceName.AllocSysString ();
        hRes = pSheet->m_pPss->Add(bstrPsName, &pDisp);
        CHECK_HRESULT(hRes)
        hRes = pDisp->QueryInterface (IID_PaperSpace, (void**)&pPs);
        CHECK_HRESULT(hRes)

        hRes = pPs->Activate();
        CHECK_HRESULT(hRes)

    }
    catch(...)
    {
        TRACE("CPaperOrientation::OnWizardFinish()");
    }

    RELEASE(pPs);
    RELEASE(pDisp)

    RELEASE(pSheet->m_pPss);

    return CPropertyPage::OnWizardFinish();
}


Examples - C++ Wizard - PaperOrientation.h

PaperOrientation.h

C++ Wizard Example

#if !defined(AFX_PAPERORIENTATION_H__2989D376_332D_4EA5_A920_1B934750376E__INCLUDED_)
#define AFX_PAPERORIENTATION_H__2989D376_332D_4EA5_A920_1B934750376E__INCLUDED_

#if _MSC_VER > 1000
#pragma once
#endif // _MSC_VER > 1000
// PaperOrientation.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CPaperOrientation dialog

class CPaperOrientation : public CPropertyPage
{
    DECLARE_DYNCREATE(CPaperOrientation)

// Construction
public:
    CPaperOrientation();
    ~CPaperOrientation();

// Dialog Data
    //{{AFX_DATA(CPaperOrientation)
    enum { IDD = IDD_PAPERORIENTATION };
        // NOTE - ClassWizard will add data members here.
        //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_DATA

// Overrides
    // ClassWizard generate virtual function overrides
    //{{AFX_VIRTUAL(CPaperOrientation)
    public:
    virtual BOOL OnSetActive();
    virtual BOOL OnWizardFinish();
    protected:
    virtual void DoDataExchange(CDataExchange* pDX);    // DDX/DDV support
    //}}AFX_VIRTUAL

// Implementation
protected:
    // Generated message map functions
    //{{AFX_MSG(CPaperOrientation)
    afx_msg void OnPorientationp();
    afx_msg void OnPorientationl();
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()

};

//{{AFX_INSERT_LOCATION}}
// Microsoft Visual C++ will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_PAPERORIENTATION_H__2989D376_332D_4EA5_A920_1B934750376E__INCLUDED_)


Examples - C++ Wizard - PaperSpaceWizard.cpp

PaperSpaceWizard.cpp

C++ Wizard Example

// PaperSpaceWizard.cpp : implementation file
//

#include "stdafx.h"
#include "resource.h"
#include "PaperSpaceWizard.h"

#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif

/////////////////////////////////////////////////////////////////////////////
// CPaperSpaceWizard

IMPLEMENT_DYNAMIC(CPaperSpaceWizard, CPropertySheet)

CPaperSpaceWizard::CPaperSpaceWizard(UINT nIDCaption, CWnd* pParentWnd, UINT iSelectPage)
    :CPropertySheet(nIDCaption, pParentWnd, iSelectPage)
{
        // add all the pages of the wizard
    AddPage(&m_Begin);
    AddPage(&m_PaperOrientation);

    // set the WIZARD97 flag so we'll get the new look
    m_psh.dwFlags |= PSH_WIZARD;//PSH_WIZARD97;
//	m_psh.dwFlags |= PSH_NOAPPLYNOW;//PSH_WIZARD97;

}

CPaperSpaceWizard::CPaperSpaceWizard(LPCTSTR pszCaption, CWnd* pParentWnd, UINT iSelectPage)
    :CPropertySheet(pszCaption, pParentWnd, iSelectPage)
{
        // add all the pages of the wizard
    AddPage(&m_Begin);
    AddPage(&m_PaperOrientation);

}

CPaperSpaceWizard::~CPaperSpaceWizard()
{
}

BEGIN_MESSAGE_MAP(CPaperSpaceWizard, CPropertySheet)
    //{{AFX_MSG_MAP(CPaperSpaceWizard)
        // NOTE - the ClassWizard will add and remove mapping macros here.
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

/////////////////////////////////////////////////////////////////////////////
// CPaperSpaceWizard message handlers


Examples - C++ Wizard - PaperSpaceWizard.h

PaperSpaceWizard.h

C++ Wizard Example

#if !defined(AFX_PAPERSPACEWIZARD_H__0751F69C_8C02_42AD_9F28_9B0FD2E73F3E__INCLUDED_)
#define AFX_PAPERSPACEWIZARD_H__0751F69C_8C02_42AD_9F28_9B0FD2E73F3E__INCLUDED_

#include "Begin.h"	// Added by ClassView
#include "PaperOrientation.h"	// Added by ClassView
#if _MSC_VER > 1000
#pragma once
#endif // _MSC_VER > 1000
// PaperSpaceWizard.h : header file
//

/////////////////////////////////////////////////////////////////////////////
// CPaperSpaceWizard

class CPaperSpaceWizard : public CPropertySheet
{
    DECLARE_DYNAMIC(CPaperSpaceWizard)

// Construction
public:
    CPaperSpaceWizard(UINT nIDCaption, CWnd* pParentWnd = NULL, UINT iSelectPage = 0);
    CPaperSpaceWizard(LPCTSTR pszCaption, CWnd* pParentWnd = NULL, UINT iSelectPage = 0);

// Attributes
public:

// Operations
public:

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CPaperSpaceWizard)
    //}}AFX_VIRTUAL

// Implementation
public:
    CPaperOrientation m_PaperOrientation;
    CBegin m_Begin;
    PAPERSPACEINFO *m_PSInfo;
    PaperSpaces *m_pPss;
    virtual ~CPaperSpaceWizard();

    // Generated message map functions
protected:
    //{{AFX_MSG(CPaperSpaceWizard)
        // NOTE - the ClassWizard will add and remove member functions here.
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

/////////////////////////////////////////////////////////////////////////////

//{{AFX_INSERT_LOCATION}}
// Microsoft Visual C++ will insert additional declarations immediately before the previous line.

#endif // !defined(AFX_PAPERSPACEWIZARD_H__0751F69C_8C02_42AD_9F28_9B0FD2E73F3E__INCLUDED_)


Examples - C++ Wizard - PSsWizard.cpp

PSsWizard.cpp

C++ Wizard Example

// PSsWizard.cpp : Implementation of CPSsWizard
#include "stdafx.h"
#include "TCPssWiz.h"
#include "PSsWizard.h"
#include "PaperSpaceWizard.h"

#include "xdbtool_i.c"
#include "imsigx_i.c"
#include "gxmps_i.c"

/////////////////////////////////////////////////////////////////////////////
// CPSsWizard

COleVariant t(-1L, VT_BOOL);
COleVariant f(0L, VT_BOOL);
COleVariant missing((long)DISP_E_PARAMNOTFOUND, VT_ERROR);

/////////////////////////////////////////////////////////////////////////////

STDMETHODIMP CPSsWizard::get_ClassID(BSTR *pVal)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;
    LPOLESTR olestr = NULL;

    try
    {
        if(SUCCEEDED( ::StringFromCLSID(CLSID_PSsWizard, &olestr)))
        {
            *pVal = ::SysAllocString(olestr);
            hRes = S_OK;
        }
    }
    catch (...)
    {
        TRACE_EXCEPTION("CPSsWizard::get_ClassID")
    }

    if (olestr != NULL)
    CoTaskMemFree(olestr);

    return hRes;
}

STDMETHODIMP CPSsWizard::get_Description(BSTR *pVal)
{
    // Get the description from the resource
    HRESULT hRes = E_FAIL;
    CString strResult;
    if (strResult.LoadString(IDS_DESCRIPTION))
    {
        *pVal = strResult.AllocSysString();
        hRes = S_OK;
    }
    return hRes;
}

STDMETHODIMP CPSsWizard::GetToolInfo(VARIANT *CommandNames, VARIANT *MenuCaptions, VARIANT *StatusPrompts, VARIANT *ToolTips, VARIANT *Enabled, VARIANT *WantsUpdates, long *ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;

    SAFEARRAYBOUND bound = {NUM_TOOLS, 0};

    CString cstrText;
    CString cstrTextTemp;

    BSTR bstrCommandName = NULL;
    BSTR bstrMenuCaption = NULL;
    BSTR bstrStatusPrompt = NULL;
    BSTR bstrToolTip = NULL;
    BOOL bEnabled = TRUE;
    BOOL bWantsUpdates = TRUE;

    long lIndicies = 0;
    try
    {

        hRes = SafeArrayRedim(CommandNames->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(MenuCaptions->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(StatusPrompts->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(ToolTips->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(Enabled->parray, &bound);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayRedim(WantsUpdates->parray, &bound);
        CHECK_HRESULT(hRes)

// AALB 141199		CString cstrText="Insert|Dimension|Tolerance";
        cstrText.LoadString (IDS_MAINMENU);
        cstrText.Insert(cstrText.GetLength (), '|');
        cstrTextTemp.LoadString (IDS_SUBMENU);
        cstrText.Insert(cstrText.GetLength (), cstrTextTemp);
        cstrText.Insert(cstrText.GetLength (), '|');
        cstrTextTemp.LoadString (IDS_MENUCAPTION);
        cstrText.Insert(cstrText.GetLength (), cstrTextTemp);
        cstrTextTemp.Empty ();

        bstrCommandName = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(CommandNames->parray, &lIndicies, (void *)bstrCommandName);
        CHECK_HRESULT(hRes)

        cstrText.Empty ();
// AALB 141199 move this string to resource		cstrText="Tolerance";
        cstrText.LoadString (IDS_MENUCAPTION);
        bstrMenuCaption = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(MenuCaptions->parray, &lIndicies, (void *)bstrMenuCaption);
        CHECK_HRESULT(hRes)
        cstrText.Empty ();

         cstrText.LoadString (IDS_PROMT0);
        bstrStatusPrompt = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(StatusPrompts->parray, &lIndicies, (void *)bstrStatusPrompt);
        CHECK_HRESULT(hRes)
        cstrText.Empty ();
// AALB 141199		cstrText="Insert tolerance symbol";
        cstrText.LoadString (IDS_TOOLTIPS);;
        bstrToolTip = cstrText.AllocSysString();
        hRes = SafeArrayPutElement(ToolTips->parray, &lIndicies, (void *)bstrToolTip);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayPutElement(Enabled->parray, &lIndicies, (void *)&bEnabled);
        CHECK_HRESULT(hRes)

        hRes = SafeArrayPutElement(WantsUpdates->parray, &lIndicies, (void *)&bWantsUpdates);
        CHECK_HRESULT(hRes)

        *ret = NUM_TOOLS;
    }
    catch (...)
    {
        if (SUCCEEDED(hRes))
            hRes = E_FAIL;
        TRACE_EXCEPTION("CPSsWizard::GetToolInfo")
    }
    return hRes;
}

STDMETHODIMP CPSsWizard::GetPicture(VARIANT_BOOL LargeButtons, VARIANT_BOOL Monochrome, IDispatch **ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    LPTSTR IDB = 0;

    HRESULT hRes = E_FAIL;
    //	CBitmap pBmp;
    try
    {
//		pBmp.LoadBitmap (IDB_BMP1);
        if(LargeButtons)
        {
            IDB = MAKEINTRESOURCE(IDB_BMP2);
        }
        else
        {
            IDB = MAKEINTRESOURCE(IDB_BMP1);
        }
        HBITMAP pBmp = ::LoadBitmap(AfxGetResourceHandle(), IDB);

        PICTDESC pict;
        pict.cbSizeofstruct = sizeof(pict);
        pict.picType = PICTYPE_BITMAP;
        pict.bmp.hbitmap = pBmp;
        pict.bmp.hpal = NULL;

        hRes = OleCreatePictureIndirect(&pict, IID_IDispatch, TRUE, (void**)ret);

        CHECK_HRESULT(hRes)
        hRes = S_OK;

    }

    catch (...)
    {
        TRACE_EXCEPTION("CPSsWizard::GetPicture")
    }

    return hRes;
}

STDMETHODIMP CPSsWizard::CopyBitmap(VARIANT_BOOL LargeButtons, VARIANT_BOOL Monochrome, VARIANT_BOOL *ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    return S_OK;
}

STDMETHODIMP CPSsWizard::UpdateToolStatus(IDispatch *ThisTool, VARIANT_BOOL *Enabled, VARIANT_BOOL *Checked, VARIANT_BOOL *ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    return S_OK;
}

STDMETHODIMP CPSsWizard::Initialize(IDispatch *ThisTool, VARIANT_BOOL *ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    return S_OK;
}

STDMETHODIMP CPSsWizard::Terminate(IDispatch *ThisTool)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    return S_OK;
}

STDMETHODIMP CPSsWizard::Run(IDispatch *ThisTool, VARIANT_BOOL *ret)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())
    HRESULT hRes = E_FAIL;

    Tool *pTool = NULL;
    IApplication *pIApp = NULL;
    Graphics* pGrs = NULL;
    IDrawing *pDr = NULL;
    long lPsscount = 0;
    COleVariant varAperture(0.2);

    COleVariant varOptional(varMissing);
    COleVariant varType((const long)imsiPolyline);
    COleVariant varItem = (0L);
    PaperSpaces *pPss = NULL;

    CString cstrText;
    BSTR bstrStatusPrompt;
    cstrText.LoadString (IDS_PROMT);
    bstrStatusPrompt = cstrText.AllocSysString();
    m_bDragging  = FALSE;
//	COleVariant varType((const long)imsiGroup);
    COleVariant varProp;
    Properties *pProps = NULL;
    Property *pProp = NULL;
    IDispatch *pIDisp = NULL;
    PAPERSPACEINFO pPSInfo;

    PaperSpace *pPs = NULL;
    IDispatch *pDisp = NULL;

    if(m_bRunned)
        return S_OK;
    try
    {

        hRes = ThisTool->QueryInterface(IID_Tool, (void **)&m_pTool);
        CHECK_HRESULT(hRes)

        hRes = m_pTool->get_Application(&m_pIApplication);
        CHECK_HRESULT(hRes)

        hRes = QueryInterface(IID_IPSsWizard, (void**)&m_pITool);
        CHECK_HRESULT(hRes)
        hRes = m_pIApplication->get_ActiveDrawing(&pDr);
        CHECK_HRESULT(hRes)

        hRes = pDr->get_PaperSpaces(&pIDisp);
        CHECK_HRESULT(hRes);
        hRes = pIDisp->QueryInterface (IID_PaperSpaces,(void**)&pPss);
        CHECK_HRESULT(hRes);

        hRes = pPss->get_Count(&lPsscount);
        CHECK_HRESULT(hRes)

        CString cstrTextTemp;
        char v[10];
        memset(v, 0, 10);
        lPsscount++;
        _ltoa(lPsscount,v, 10);
        lPsscount--;
//		AfxMessageBox("PaperSpace wizard tool is runned.");

        CPaperSpaceWizard dlg(IDS_DESCRIPTION,NULL, 0);
//		CString cstrWizCaption;
        cstrText.LoadString (IDS_PSNAMETEMPLATE);
//		cstrTextTemp = " - Begin";
        cstrText.Insert((cstrText.GetLength ()), " ");
        cstrText.Insert((cstrText.GetLength ()), v);
        dlg.m_PSInfo = & pPSInfo;
        dlg.m_pPss = pPss;
        dlg.m_pPss->AddRef();

        dlg.m_PSInfo->bPaperOrientation = 0;
        dlg.m_PSInfo->cstrPSpaceName = cstrText;

        int nResponse = dlg.DoModal();
        nResponse = IDOK;
        if (nResponse == IDOK)
        {
            // TODO: Place code here to handle when the dialog is
            //  dismissed with OK

            BSTR bstrPsName;

            bstrPsName = pPSInfo.cstrPSpaceName.AllocSysString ();
/*
            hRes = pPss->Add(bstrPsName, &pDisp);
            CHECK_HRESULT(hRes)
            hRes = pDisp->QueryInterface (IID_PaperSpace, (void**)&pPs);
            CHECK_HRESULT(hRes)

            hRes = pPs->Activate();
            CHECK_HRESULT(hRes)
*/

        }
        else if (nResponse == IDCANCEL)
        {
            // TODO: Place code here to handle when the dialog is
            //  dismissed with Cancel
        }

/*
        hRes = ThisTool->QueryInterface(IID_Tool, (void **)&m_pTool);
        CHECK_HRESULT(hRes)

        hRes = m_pTool->get_Application(&m_pIApplication);
        CHECK_HRESULT(hRes)

        hRes = QueryInterface(IID_IPSsWizard, (void**)&m_pITool);
        CHECK_HRESULT(hRes)
        hRes = m_pIApplication->QueryInterface(IID_IToolEvents, (void **)&m_pIToolEvents);
        CHECK_HRESULT(hRes)
        hRes = m_pIToolEvents->ToolChangePrompt(m_pITool,bstrStatusPrompt , FALSE);
        CHECK_HRESULT(hRes)
*/
    }
    catch (...)
    {
        TRACE_EXCEPTION("CPSsWizard::Run")
    }

    RELEASE(pPs)
    RELEASE(pDisp)
    RELEASE(pPss);
    RELEASE(pDr);
    RELEASE(m_pIApplication);
    return S_OK;
}

STDMETHODIMP CPSsWizard::MouseDown(IDispatch *WhichDrawing, IDispatch *WhichView, IDispatch *WhichWindow, short Button, long Shift, long X, long Y, VARIANT_BOOL *Cancel)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    return S_OK;
}

STDMETHODIMP CPSsWizard::MouseUp(IDispatch *WhichDrawing, IDispatch *WhichView, IDispatch *WhichWindow, short Button, long Shift, long X, long Y, VARIANT_BOOL *Cancel)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    return S_OK;
}

STDMETHODIMP CPSsWizard::MouseMove(IDispatch *WhichDrawing, IDispatch *WhichView, IDispatch *WhichWindow, long Shift, long X, long Y, VARIANT_BOOL *pbCancel)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    return S_OK;
}

STDMETHODIMP CPSsWizard::RunTool(IDispatch *ThisTool)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState())

    // TODO: Add your implementation code here

    return S_OK;
}
void CPSsWizard::ConnectEvents(IDispatch *ThisTool)
{

     HRESULT hRes = S_OK;

    if (m_dwEventConnection != 0)
    {
//		AfxMessageBox("Already connected.");
        return;
    }

    try
    {

        DWORD dwEventMask = imsiEventMouseUp
//							 | imsiEventSelectionChange
                             | imsiEventMouseMove
                             | imsiEventMouseDown
                             | imsiEventDrawingDeactivate
                             | imsiEventRunTool
                             | imsiEventBeforeExit;
//							 | imsiEventMouseMove;
//							 | imsiEventPointSnapped;

        COleVariant var((long)dwEventMask);
        hRes = m_pIApplication->ConnectEvents(ThisTool,
            &var,
            (long*)&m_dwEventConnection);

        if (FAILED(hRes))
        {
    //		AfxMessageBox("Connection not established.");
            return;
        }
    }
    catch (...)
    {
        TRACE_EXCEPTION("CPSsWizard::ConnectEvents")
    }

}

void CPSsWizard::DisconnectEvents()
{

    if (m_pIApplication == NULL || m_dwEventConnection == 0)
        return;
    try
    {

        HRESULT	hRes = m_pIApplication->DisconnectEvents(m_dwEventConnection);
        CHECK_HRESULT(hRes)
        if (FAILED(hRes))
        {
//			AfxMessageBox("Connection not broken.");
            return;

        }
        m_dwEventConnection = 0;

    }

    catch (...)
    {
        TRACE_EXCEPTION("CPSsWizard::DisconnectEvents")
    }
//	if(m_pIApplication != NULL)
//	{
//		m_pIApplication->Release();
//		m_pIApplication = NULL;
//	}

}
void CPSsWizard::Destroy()
{
//	RELEASE(m_pView)

    CString cstrT;
    cstrT.Empty ();
    BSTR bstrPromt = NULL;
    bstrPromt = cstrT.AllocSysString ();
    m_pIToolEvents->ToolChangePrompt(m_pITool,bstrPromt, FALSE);

    RELEASE(m_pIToolEvents)
    DisconnectEvents();
    RELEASE(m_pDragGraphic);
    RELEASE(m_pITool);
    RELEASE(m_pTool);
    RELEASE(m_pIApplication);

    m_bRunned = FALSE;

}


Examples - C++ Wizard - PSsWizard.h

PSsWizard.h

C++ Wizard Example

// PSsWizard.h : Declaration of the CPSsWizard

#ifndef __PSSWIZARD_H_
#define __PSSWIZARD_H_

#include "resource.h"       // main symbols

/////////////////////////////////////////////////////////////////////////////
// CPSsWizard
class ATL_NO_VTABLE CPSsWizard :
    public CComObjectRootEx<CComSingleThreadModel>,
    public CComCoClass<CPSsWizard, &CLSID_PSsWizard>,
    public IDispatchImpl<IPSsWizard, &IID_IPSsWizard, &LIBID_TCPSSWIZLib>
{
public:
    CPSsWizard()
    {
        m_bRunned = false;
    }

DECLARE_REGISTRY_RESOURCEID(IDR_PSSWIZARD)

DECLARE_PROTECT_FINAL_CONSTRUCT()

BEGIN_COM_MAP(CPSsWizard)
    COM_INTERFACE_ENTRY(IPSsWizard)
    COM_INTERFACE_ENTRY(IDispatch)
END_COM_MAP()

// IPSsWizard
public:

    Tool* m_pTool;
    IPSsWizard* m_pITool;
    IToolEvents* m_pIToolEvents;

    BOOL m_bRunned;
    BOOL m_bInit;
    BOOL m_bUndoInit;
    IApplication* m_pIApplication;
    DWORD m_dwEventConnection;

    void DisconnectEvents();
    void ConnectEvents(IDispatch *ThisTool);
    void Destroy();
    BOOL Init();
    VARIANT m_dragOutline;
    IGraphic* m_pDragGraphic;
    BOOL m_bDragging;
    View* m_pView;

    STDMETHOD(RunTool)(/*[in]*/ IDispatch * ThisTool);
    STDMETHOD(MouseMove)(/*[in]*/IDispatch *WhichDrawing, /*[in]*/IDispatch *WhichView, /*[in]*/IDispatch *WhichWindow, /*[in]*/long Shift, /*[in]*/long X, /*[in]*/long Y, /*[in, out]*/VARIANT_BOOL *pbCancel);
    STDMETHOD(MouseUp)(/*[in]*/IDispatch *WhichDrawing, /*[in]*/IDispatch *WhichView, /*[in]*/IDispatch *WhichWindow, /*[in]*/short Button, /*[in]*/long Shift, /*[in]*/long X, /*[in]*/long Y, /*[in, out]*/VARIANT_BOOL *Cancel);
    STDMETHOD(MouseDown)(/*[in]*/IDispatch *WhichDrawing, /*[in]*/IDispatch *WhichView, /*[in]*/IDispatch *WhichWindow, /*[in]*/short Button, /*[in]*/long Shift, /*[in]*/long X, /*[in]*/long Y, /*[in, out]*/VARIANT_BOOL *Cancel);
    STDMETHOD(Run)(/*[in]*/ IDispatch* ThisTool, /*[out, retval]*/ VARIANT_BOOL* ret);
    STDMETHOD(Terminate)(/*[in]*/ IDispatch * ThisTool);
    STDMETHOD(Initialize)(/*[in]*/ IDispatch * ThisTool, /*[out, retval]*/ VARIANT_BOOL* ret);
    STDMETHOD(UpdateToolStatus)(/*[in]*/ IDispatch* ThisTool, /*[in, out]*/ VARIANT_BOOL* Enabled, /*[in, out]*/ VARIANT_BOOL* Checked, /*[out, retval]*/ VARIANT_BOOL* ret);
    STDMETHOD(CopyBitmap)(/*[in]*/ VARIANT_BOOL LargeButtons, /*[in]*/ VARIANT_BOOL Monochrome, /*[out, retval]*/ VARIANT_BOOL* ret);
    STDMETHOD(GetPicture)(/*[in]*/ VARIANT_BOOL LargeButtons, /*[in]*/ VARIANT_BOOL Monochrome, /*[out, retval]*/ IDispatch** ret);
    STDMETHOD(GetToolInfo)(/*[in, out]*/ VARIANT* CommandNames, /*[in, out]*/ VARIANT* MenuCaptions, /*[in, out]*/ VARIANT* StatusPrompts, /*[in, out]*/ VARIANT* ToolTips, /*[in, out]*/ VARIANT* Enabled, /*[in, out]*/ VARIANT* WantsUpdates, /*[out, retval]*/ long* ret);
    STDMETHOD(get_Description)(/*[out, retval]*/ BSTR *pVal);
    STDMETHOD(get_ClassID)(/*[out, retval]*/ BSTR *pVal);
};

#endif //__PSSWIZARD_H_


Examples - C++ Wizard - TCPssWiz.cpp

TCPssWiz.cpp

C++ Wizard Example

// TCPssWiz.cpp : Implementation of DLL Exports.

// Note: Proxy/Stub Information
//      To build a separate proxy/stub DLL,
//      run nmake -f TCPssWizps.mk in the project directory.

#include "stdafx.h"
#include "resource.h"
#include <initguid.h>
#include "TCPssWiz.h"

#include "TCPssWiz_i.c"
#include "PSsWizard.h"

CComModule _Module;
COleVariant varMissing((long)DISP_E_PARAMNOTFOUND, VT_ERROR);

BEGIN_OBJECT_MAP(ObjectMap)
OBJECT_ENTRY(CLSID_PSsWizard, CPSsWizard)
END_OBJECT_MAP()

class CTCPssWizApp : public CWinApp
{
public:

// Overrides
    // ClassWizard generated virtual function overrides
    //{{AFX_VIRTUAL(CTCPssWizApp)
    public:
    virtual BOOL InitInstance();
    virtual int ExitInstance();
    //}}AFX_VIRTUAL

    //{{AFX_MSG(CTCPssWizApp)
        // NOTE - the ClassWizard will add and remove member functions here.
        //    DO NOT EDIT what you see in these blocks of generated code !
    //}}AFX_MSG
    DECLARE_MESSAGE_MAP()
};

BEGIN_MESSAGE_MAP(CTCPssWizApp, CWinApp)
    //{{AFX_MSG_MAP(CTCPssWizApp)
        // NOTE - the ClassWizard will add and remove mapping macros here.
        //    DO NOT EDIT what you see in these blocks of generated code!
    //}}AFX_MSG_MAP
END_MESSAGE_MAP()

CTCPssWizApp theApp;

BOOL CTCPssWizApp::InitInstance()
{
    _Module.Init(ObjectMap, m_hInstance, &LIBID_TCPSSWIZLib);
    return CWinApp::InitInstance();
}

int CTCPssWizApp::ExitInstance()
{
    _Module.Term();
    return CWinApp::ExitInstance();
}

/////////////////////////////////////////////////////////////////////////////
// Used to determine whether the DLL can be unloaded by OLE

STDAPI DllCanUnloadNow(void)
{
    AFX_MANAGE_STATE(AfxGetStaticModuleState());
    return (AfxDllCanUnloadNow()==S_OK && _Module.GetLockCount()==0) ? S_OK : S_FALSE;
}

/////////////////////////////////////////////////////////////////////////////
// Returns a class factory to create an object of the requested type

STDAPI DllGetClassObject(REFCLSID rclsid, REFIID riid, LPVOID* ppv)
{
    return _Module.GetClassObject(rclsid, riid, ppv);
}

/////////////////////////////////////////////////////////////////////////////
// DllRegisterServer - Adds entries to the system registry

STDAPI DllRegisterServer(void)
{
    // registers object, typelib and all interfaces in typelib
    return _Module.RegisterServer(TRUE);
}

/////////////////////////////////////////////////////////////////////////////
// DllUnregisterServer - Removes entries from the system registry

STDAPI DllUnregisterServer(void)
{
    return _Module.UnregisterServer(TRUE);
}


Examples - C++ Wizard - TCPssWiz.h

TCPssWiz.h

C++ Wizard Example

/* this ALWAYS GENERATED file contains the definitions for the interfaces */

/* File created by MIDL compiler version 5.01.0164 */
/* at Fri Sep 08 11:19:45 2000
 */
/* Compiler settings for E:\tc70\SDKv7\SAMPLES\CPP\Tools\TCPssWiz\TCPssWiz.idl:
    Oicf (OptLev=i2), W1, Zp8, env=Win32, ms_ext, c_ext
    error checks: allocation ref bounds_check enum stub_data
*/
//@@MIDL_FILE_HEADING(  )

/* verify that the <rpcndr.h> version is high enough to compile this file*/
#ifndef __REQUIRED_RPCNDR_H_VERSION__
#define __REQUIRED_RPCNDR_H_VERSION__ 440
#endif

#include "rpc.h"
#include "rpcndr.h"

#ifndef __RPCNDR_H_VERSION__
#error this stub requires an updated version of <rpcndr.h>
#endif // __RPCNDR_H_VERSION__

#ifndef COM_NO_WINDOWS_H
#include "windows.h"
#include "ole2.h"
#endif /*COM_NO_WINDOWS_H*/

#ifndef __TCPssWiz_h__
#define __TCPssWiz_h__

#ifdef __cplusplus
extern "C"{
#endif

/* Forward Declarations */

#ifndef __IPSsWizard_FWD_DEFINED__
#define __IPSsWizard_FWD_DEFINED__
typedef interface IPSsWizard IPSsWizard;
#endif 	/* __IPSsWizard_FWD_DEFINED__ */

#ifndef __PSsWizard_FWD_DEFINED__
#define __PSsWizard_FWD_DEFINED__

#ifdef __cplusplus
typedef class PSsWizard PSsWizard;
#else
typedef struct PSsWizard PSsWizard;
#endif /* __cplusplus */

#endif 	/* __PSsWizard_FWD_DEFINED__ */

/* header files for imported files */
#include "oaidl.h"
#include "ocidl.h"

void __RPC_FAR * __RPC_USER MIDL_user_allocate(size_t);
void __RPC_USER MIDL_user_free( void __RPC_FAR * );

#ifndef __IPSsWizard_INTERFACE_DEFINED__
#define __IPSsWizard_INTERFACE_DEFINED__

/* interface IPSsWizard */
/* [unique][helpstring][dual][uuid][object] */

EXTERN_C const IID IID_IPSsWizard;

#if defined(__cplusplus) && !defined(CINTERFACE)

    MIDL_INTERFACE("2FEE78D4-9067-4287-A67A-AF62FE87549D")
    IPSsWizard : public IDispatch
    {
    public:
        virtual /* [helpstring][id][propget] */ HRESULT STDMETHODCALLTYPE get_ClassID(
            /* [retval][out] */ BSTR __RPC_FAR *pVal) = 0;

        virtual /* [helpstring][id][propget] */ HRESULT STDMETHODCALLTYPE get_Description(
            /* [retval][out] */ BSTR __RPC_FAR *pVal) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE GetToolInfo(
            /* [out][in] */ VARIANT __RPC_FAR *CommandNames,
            /* [out][in] */ VARIANT __RPC_FAR *MenuCaptions,
            /* [out][in] */ VARIANT __RPC_FAR *StatusPrompts,
            /* [out][in] */ VARIANT __RPC_FAR *ToolTips,
            /* [out][in] */ VARIANT __RPC_FAR *Enabled,
            /* [out][in] */ VARIANT __RPC_FAR *WantsUpdates,
            /* [retval][out] */ long __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE GetPicture(
            /* [in] */ VARIANT_BOOL LargeButtons,
            /* [in] */ VARIANT_BOOL Monochrome,
            /* [retval][out] */ IDispatch __RPC_FAR *__RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE CopyBitmap(
            /* [in] */ VARIANT_BOOL LargeButtons,
            /* [in] */ VARIANT_BOOL Monochrome,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE UpdateToolStatus(
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Enabled,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Checked,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE Initialize(
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE Terminate(
            /* [in] */ IDispatch __RPC_FAR *ThisTool) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE Run(
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE MouseDown(
            /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
            /* [in] */ IDispatch __RPC_FAR *WhichView,
            /* [in] */ IDispatch __RPC_FAR *WhichWindow,
            /* [in] */ short Button,
            /* [in] */ long Shift,
            /* [in] */ long X,
            /* [in] */ long Y,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Cancel) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE MouseUp(
            /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
            /* [in] */ IDispatch __RPC_FAR *WhichView,
            /* [in] */ IDispatch __RPC_FAR *WhichWindow,
            /* [in] */ short Button,
            /* [in] */ long Shift,
            /* [in] */ long X,
            /* [in] */ long Y,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Cancel) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE MouseMove(
            /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
            /* [in] */ IDispatch __RPC_FAR *WhichView,
            /* [in] */ IDispatch __RPC_FAR *WhichWindow,
            /* [in] */ long Shift,
            /* [in] */ long X,
            /* [in] */ long Y,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *pbCancel) = 0;

        virtual /* [helpstring][id] */ HRESULT STDMETHODCALLTYPE RunTool(
            /* [in] */ IDispatch __RPC_FAR *ThisTool) = 0;

    };

#else 	/* C style interface */

    typedef struct IPSsWizardVtbl
    {
        BEGIN_INTERFACE

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *QueryInterface )(
            IPSsWizard __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [iid_is][out] */ void __RPC_FAR *__RPC_FAR *ppvObject);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *AddRef )(
            IPSsWizard __RPC_FAR * This);

        ULONG ( STDMETHODCALLTYPE __RPC_FAR *Release )(
            IPSsWizard __RPC_FAR * This);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetTypeInfoCount )(
            IPSsWizard __RPC_FAR * This,
            /* [out] */ UINT __RPC_FAR *pctinfo);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetTypeInfo )(
            IPSsWizard __RPC_FAR * This,
            /* [in] */ UINT iTInfo,
            /* [in] */ LCID lcid,
            /* [out] */ ITypeInfo __RPC_FAR *__RPC_FAR *ppTInfo);

        HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetIDsOfNames )(
            IPSsWizard __RPC_FAR * This,
            /* [in] */ REFIID riid,
            /* [size_is][in] */ LPOLESTR __RPC_FAR *rgszNames,
            /* [in] */ UINT cNames,
            /* [in] */ LCID lcid,
            /* [size_is][out] */ DISPID __RPC_FAR *rgDispId);

        /* [local] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Invoke )(
            IPSsWizard __RPC_FAR * This,
            /* [in] */ DISPID dispIdMember,
            /* [in] */ REFIID riid,
            /* [in] */ LCID lcid,
            /* [in] */ WORD wFlags,
            /* [out][in] */ DISPPARAMS __RPC_FAR *pDispParams,
            /* [out] */ VARIANT __RPC_FAR *pVarResult,
            /* [out] */ EXCEPINFO __RPC_FAR *pExcepInfo,
            /* [out] */ UINT __RPC_FAR *puArgErr);

        /* [helpstring][id][propget] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *get_ClassID )(
            IPSsWizard __RPC_FAR * This,
            /* [retval][out] */ BSTR __RPC_FAR *pVal);

        /* [helpstring][id][propget] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *get_Description )(
            IPSsWizard __RPC_FAR * This,
            /* [retval][out] */ BSTR __RPC_FAR *pVal);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetToolInfo )(
            IPSsWizard __RPC_FAR * This,
            /* [out][in] */ VARIANT __RPC_FAR *CommandNames,
            /* [out][in] */ VARIANT __RPC_FAR *MenuCaptions,
            /* [out][in] */ VARIANT __RPC_FAR *StatusPrompts,
            /* [out][in] */ VARIANT __RPC_FAR *ToolTips,
            /* [out][in] */ VARIANT __RPC_FAR *Enabled,
            /* [out][in] */ VARIANT __RPC_FAR *WantsUpdates,
            /* [retval][out] */ long __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *GetPicture )(
            IPSsWizard __RPC_FAR * This,
            /* [in] */ VARIANT_BOOL LargeButtons,
            /* [in] */ VARIANT_BOOL Monochrome,
            /* [retval][out] */ IDispatch __RPC_FAR *__RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *CopyBitmap )(
            IPSsWizard __RPC_FAR * This,
            /* [in] */ VARIANT_BOOL LargeButtons,
            /* [in] */ VARIANT_BOOL Monochrome,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *UpdateToolStatus )(
            IPSsWizard __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Enabled,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Checked,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Initialize )(
            IPSsWizard __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Terminate )(
            IPSsWizard __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *ThisTool);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *Run )(
            IPSsWizard __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *ThisTool,
            /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *MouseDown )(
            IPSsWizard __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
            /* [in] */ IDispatch __RPC_FAR *WhichView,
            /* [in] */ IDispatch __RPC_FAR *WhichWindow,
            /* [in] */ short Button,
            /* [in] */ long Shift,
            /* [in] */ long X,
            /* [in] */ long Y,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Cancel);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *MouseUp )(
            IPSsWizard __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
            /* [in] */ IDispatch __RPC_FAR *WhichView,
            /* [in] */ IDispatch __RPC_FAR *WhichWindow,
            /* [in] */ short Button,
            /* [in] */ long Shift,
            /* [in] */ long X,
            /* [in] */ long Y,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *Cancel);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *MouseMove )(
            IPSsWizard __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
            /* [in] */ IDispatch __RPC_FAR *WhichView,
            /* [in] */ IDispatch __RPC_FAR *WhichWindow,
            /* [in] */ long Shift,
            /* [in] */ long X,
            /* [in] */ long Y,
            /* [out][in] */ VARIANT_BOOL __RPC_FAR *pbCancel);

        /* [helpstring][id] */ HRESULT ( STDMETHODCALLTYPE __RPC_FAR *RunTool )(
            IPSsWizard __RPC_FAR * This,
            /* [in] */ IDispatch __RPC_FAR *ThisTool);

        END_INTERFACE
    } IPSsWizardVtbl;

    interface IPSsWizard
    {
        CONST_VTBL struct IPSsWizardVtbl __RPC_FAR *lpVtbl;
    };

#ifdef COBJMACROS

#define IPSsWizard_QueryInterface(This,riid,ppvObject)	\
    (This)->lpVtbl -> QueryInterface(This,riid,ppvObject)

#define IPSsWizard_AddRef(This)	\
    (This)->lpVtbl -> AddRef(This)

#define IPSsWizard_Release(This)	\
    (This)->lpVtbl -> Release(This)

#define IPSsWizard_GetTypeInfoCount(This,pctinfo)	\
    (This)->lpVtbl -> GetTypeInfoCount(This,pctinfo)

#define IPSsWizard_GetTypeInfo(This,iTInfo,lcid,ppTInfo)	\
    (This)->lpVtbl -> GetTypeInfo(This,iTInfo,lcid,ppTInfo)

#define IPSsWizard_GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)	\
    (This)->lpVtbl -> GetIDsOfNames(This,riid,rgszNames,cNames,lcid,rgDispId)

#define IPSsWizard_Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)	\
    (This)->lpVtbl -> Invoke(This,dispIdMember,riid,lcid,wFlags,pDispParams,pVarResult,pExcepInfo,puArgErr)

#define IPSsWizard_get_ClassID(This,pVal)	\
    (This)->lpVtbl -> get_ClassID(This,pVal)

#define IPSsWizard_get_Description(This,pVal)	\
    (This)->lpVtbl -> get_Description(This,pVal)

#define IPSsWizard_GetToolInfo(This,CommandNames,MenuCaptions,StatusPrompts,ToolTips,Enabled,WantsUpdates,ret)	\
    (This)->lpVtbl -> GetToolInfo(This,CommandNames,MenuCaptions,StatusPrompts,ToolTips,Enabled,WantsUpdates,ret)

#define IPSsWizard_GetPicture(This,LargeButtons,Monochrome,ret)	\
    (This)->lpVtbl -> GetPicture(This,LargeButtons,Monochrome,ret)

#define IPSsWizard_CopyBitmap(This,LargeButtons,Monochrome,ret)	\
    (This)->lpVtbl -> CopyBitmap(This,LargeButtons,Monochrome,ret)

#define IPSsWizard_UpdateToolStatus(This,ThisTool,Enabled,Checked,ret)	\
    (This)->lpVtbl -> UpdateToolStatus(This,ThisTool,Enabled,Checked,ret)

#define IPSsWizard_Initialize(This,ThisTool,ret)	\
    (This)->lpVtbl -> Initialize(This,ThisTool,ret)

#define IPSsWizard_Terminate(This,ThisTool)	\
    (This)->lpVtbl -> Terminate(This,ThisTool)

#define IPSsWizard_Run(This,ThisTool,ret)	\
    (This)->lpVtbl -> Run(This,ThisTool,ret)

#define IPSsWizard_MouseDown(This,WhichDrawing,WhichView,WhichWindow,Button,Shift,X,Y,Cancel)	\
    (This)->lpVtbl -> MouseDown(This,WhichDrawing,WhichView,WhichWindow,Button,Shift,X,Y,Cancel)

#define IPSsWizard_MouseUp(This,WhichDrawing,WhichView,WhichWindow,Button,Shift,X,Y,Cancel)	\
    (This)->lpVtbl -> MouseUp(This,WhichDrawing,WhichView,WhichWindow,Button,Shift,X,Y,Cancel)

#define IPSsWizard_MouseMove(This,WhichDrawing,WhichView,WhichWindow,Shift,X,Y,pbCancel)	\
    (This)->lpVtbl -> MouseMove(This,WhichDrawing,WhichView,WhichWindow,Shift,X,Y,pbCancel)

#define IPSsWizard_RunTool(This,ThisTool)	\
    (This)->lpVtbl -> RunTool(This,ThisTool)

#endif /* COBJMACROS */

#endif 	/* C style interface */

/* [helpstring][id][propget] */ HRESULT STDMETHODCALLTYPE IPSsWizard_get_ClassID_Proxy(
    IPSsWizard __RPC_FAR * This,
    /* [retval][out] */ BSTR __RPC_FAR *pVal);

void __RPC_STUB IPSsWizard_get_ClassID_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id][propget] */ HRESULT STDMETHODCALLTYPE IPSsWizard_get_Description_Proxy(
    IPSsWizard __RPC_FAR * This,
    /* [retval][out] */ BSTR __RPC_FAR *pVal);

void __RPC_STUB IPSsWizard_get_Description_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IPSsWizard_GetToolInfo_Proxy(
    IPSsWizard __RPC_FAR * This,
    /* [out][in] */ VARIANT __RPC_FAR *CommandNames,
    /* [out][in] */ VARIANT __RPC_FAR *MenuCaptions,
    /* [out][in] */ VARIANT __RPC_FAR *StatusPrompts,
    /* [out][in] */ VARIANT __RPC_FAR *ToolTips,
    /* [out][in] */ VARIANT __RPC_FAR *Enabled,
    /* [out][in] */ VARIANT __RPC_FAR *WantsUpdates,
    /* [retval][out] */ long __RPC_FAR *ret);

void __RPC_STUB IPSsWizard_GetToolInfo_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IPSsWizard_GetPicture_Proxy(
    IPSsWizard __RPC_FAR * This,
    /* [in] */ VARIANT_BOOL LargeButtons,
    /* [in] */ VARIANT_BOOL Monochrome,
    /* [retval][out] */ IDispatch __RPC_FAR *__RPC_FAR *ret);

void __RPC_STUB IPSsWizard_GetPicture_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IPSsWizard_CopyBitmap_Proxy(
    IPSsWizard __RPC_FAR * This,
    /* [in] */ VARIANT_BOOL LargeButtons,
    /* [in] */ VARIANT_BOOL Monochrome,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IPSsWizard_CopyBitmap_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IPSsWizard_UpdateToolStatus_Proxy(
    IPSsWizard __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *ThisTool,
    /* [out][in] */ VARIANT_BOOL __RPC_FAR *Enabled,
    /* [out][in] */ VARIANT_BOOL __RPC_FAR *Checked,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IPSsWizard_UpdateToolStatus_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IPSsWizard_Initialize_Proxy(
    IPSsWizard __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *ThisTool,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IPSsWizard_Initialize_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IPSsWizard_Terminate_Proxy(
    IPSsWizard __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *ThisTool);

void __RPC_STUB IPSsWizard_Terminate_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IPSsWizard_Run_Proxy(
    IPSsWizard __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *ThisTool,
    /* [retval][out] */ VARIANT_BOOL __RPC_FAR *ret);

void __RPC_STUB IPSsWizard_Run_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IPSsWizard_MouseDown_Proxy(
    IPSsWizard __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
    /* [in] */ IDispatch __RPC_FAR *WhichView,
    /* [in] */ IDispatch __RPC_FAR *WhichWindow,
    /* [in] */ short Button,
    /* [in] */ long Shift,
    /* [in] */ long X,
    /* [in] */ long Y,
    /* [out][in] */ VARIANT_BOOL __RPC_FAR *Cancel);

void __RPC_STUB IPSsWizard_MouseDown_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IPSsWizard_MouseUp_Proxy(
    IPSsWizard __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
    /* [in] */ IDispatch __RPC_FAR *WhichView,
    /* [in] */ IDispatch __RPC_FAR *WhichWindow,
    /* [in] */ short Button,
    /* [in] */ long Shift,
    /* [in] */ long X,
    /* [in] */ long Y,
    /* [out][in] */ VARIANT_BOOL __RPC_FAR *Cancel);

void __RPC_STUB IPSsWizard_MouseUp_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IPSsWizard_MouseMove_Proxy(
    IPSsWizard __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *WhichDrawing,
    /* [in] */ IDispatch __RPC_FAR *WhichView,
    /* [in] */ IDispatch __RPC_FAR *WhichWindow,
    /* [in] */ long Shift,
    /* [in] */ long X,
    /* [in] */ long Y,
    /* [out][in] */ VARIANT_BOOL __RPC_FAR *pbCancel);

void __RPC_STUB IPSsWizard_MouseMove_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

/* [helpstring][id] */ HRESULT STDMETHODCALLTYPE IPSsWizard_RunTool_Proxy(
    IPSsWizard __RPC_FAR * This,
    /* [in] */ IDispatch __RPC_FAR *ThisTool);

void __RPC_STUB IPSsWizard_RunTool_Stub(
    IRpcStubBuffer *This,
    IRpcChannelBuffer *_pRpcChannelBuffer,
    PRPC_MESSAGE _pRpcMessage,
    DWORD *_pdwStubPhase);

#endif 	/* __IPSsWizard_INTERFACE_DEFINED__ */

#ifndef __TCPSSWIZLib_LIBRARY_DEFINED__
#define __TCPSSWIZLib_LIBRARY_DEFINED__

/* library TCPSSWIZLib */
/* [helpstring][version][uuid] */

EXTERN_C const IID LIBID_TCPSSWIZLib;

EXTERN_C const CLSID CLSID_PSsWizard;

#ifdef __cplusplus

class DECLSPEC_UUID("BDA1344C-D91F-4557-BBB1-59C5B1AD1645")
PSsWizard;
#endif
#endif /* __TCPSSWIZLib_LIBRARY_DEFINED__ */

/* Additional Prototypes for ALL interfaces */

unsigned long             __RPC_USER  BSTR_UserSize(     unsigned long __RPC_FAR *, unsigned long            , BSTR __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  BSTR_UserMarshal(  unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, BSTR __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  BSTR_UserUnmarshal(unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, BSTR __RPC_FAR * );
void                      __RPC_USER  BSTR_UserFree(     unsigned long __RPC_FAR *, BSTR __RPC_FAR * );

unsigned long             __RPC_USER  VARIANT_UserSize(     unsigned long __RPC_FAR *, unsigned long            , VARIANT __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  VARIANT_UserMarshal(  unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, VARIANT __RPC_FAR * );
unsigned char __RPC_FAR * __RPC_USER  VARIANT_UserUnmarshal(unsigned long __RPC_FAR *, unsigned char __RPC_FAR *, VARIANT __RPC_FAR * );
void                      __RPC_USER  VARIANT_UserFree(     unsigned long __RPC_FAR *, VARIANT __RPC_FAR * );

/* end of Additional Prototypes */

#ifdef __cplusplus
}
#endif

#endif