www.pudn.com > dwg.rar > Form1.frm
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton Command1
Caption = "Command1"
Height = 1095
Left = 1200
TabIndex = 0
Top = 600
Width = 2175
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'********************************************************
'*
'* VB写DWG图形文件包含函数,动态连接库为dwg.dll
'* 作者：朱群 2001.8.5
'* Email:zhuqunyj@sina.com.cn
'*********************************************************
'*********************************************************
' 线型定义
Const CONTINUOUS = 0
Const DASHED = 1
Const HIDDEN = 2
Const Center = 3
Const PHANTOM = 4
Const DOT = 5
Const DASHDOT = 6
Const BORDER = 7
Const DIVIDE = 8
' 颜色定义
Const Red = 1
Const Yellow = 2
Const Green = 3
Const Cyan = 4
Const Blue = 5
Const Magenta = 6
Const White = 7
Const STANDARD = 0 ' txt
Const HZ_CMPLX = 1 ' complex,hztxt
Const CMPLX_VERT = 2 ' complex 垂直字型 大字体无垂直字型
Const HZ_ROMS = 3 ' romans,tztxt
Const ROMS_VERT = 4 ' romans 垂直字型 大字体无垂直字型
'************************
' 文本对齐方式及特征定义
' 方式设置
Const Rota = 1
Const Xscal = 2 ' X比例因子
Const Obliq = 4 ' 倾斜角
Const Setsty = 8 ' 设字型
Const Rgnsty = 16 ' 生成方式
Const Dqsty = 96 ' 对齐
' 生成方式
Const Bkword = 2 ' 反向
Const Updown = 4 ' 颠倒
' 对齐方式
Const dqStart = 0 ' 起点
Const dqCenter = 1 ' 中央
Const dqRight = 2 ' 右对齐
Const dqAlign = 3 ' 两点这间对准,高度可变
Const dqMid = 4 ' 中点对准
Const dqFit = 5 ' 文本在两点之间拟合,宽度可变
Private Declare Function startdwg Lib "dwg.dll" (ByVal Name As String) As Integer
Private Declare Sub enddwg Lib "dwg.dll" ()
Private Declare Sub wsolid Lib "dwg.dll" (ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal x3 As Double, ByVal y3 As Double, ByVal x4 As Double, ByVal y4 As Double)
Private Declare Sub chgcolor Lib "dwg.dll" (ByVal x1 As Integer)
Private Declare Sub chgltype Lib "dwg.dll" (ByVal x1 As Integer)
Private Declare Sub colorbylayer Lib "dwg.dll" ()
Private Declare Sub ltypebylayer Lib "dwg.dll" ()
Private Declare Sub wpoint Lib "dwg.dll" (ByVal x1 As Double, ByVal y1 As Double)
Private Declare Sub wcircle Lib "dwg.dll" (ByVal x As Double, ByVal y As Double, ByVal r As Double)
Private Declare Sub wline Lib "dwg.dll" (ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double)
Private Declare Sub warc Lib "dwg.dll" (ByVal x As Double, ByVal y As Double, ByVal r As Double, ByVal sa As Double, ByVal ea As Double)
Private Declare Sub settexthigh Lib "dwg.dll" (ByVal h As Double)
Private Declare Sub settextrotang Lib "dwg.dll" (ByVal rotang As Double)
Private Declare Sub settextxscale Lib "dwg.dll" (ByVal xs As Double)
Private Declare Sub settextobliq Lib "dwg.dll" (ByVal obl As Double)
Private Declare Sub settextstyle Lib "dwg.dll" (ByVal sty As Integer)
Private Declare Sub settextccstyle Lib "dwg.dll" (ByVal ccsty As Integer)
Private Declare Sub settextdqstyle Lib "dwg.dll" (ByVal dq As Integer)
Private Declare Sub cltextset Lib "dwg.dll" ()
Private Declare Sub setlayer Lib "dwg.dll" (ByVal layname As String, ByVal color As Integer, ByVal linetype As Integer)
Private Declare Sub setplinew Lib "dwg.dll" (ByVal sw As Double, ByVal ew As Double)
Private Declare Sub wpline Lib "dwg.dll" (ByVal attr2 As Integer)
Private Declare Sub wvertex Lib "dwg.dll" (ByVal x As Double, ByVal y As Double, ByVal attr2 As Integer)
Private Declare Sub wseqend Lib "dwg.dll" ()
Private Declare Sub wdoughnut Lib "dwg.dll" (ByVal x As Double, ByVal y As Double, ByVal rr As Double, ByVal ww As Double)
Private Declare Sub w3dface Lib "dwg.dll" (ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double, ByVal x3 As Double, ByVal y3 As Double, ByVal x4 As Double, ByVal y4 As Double)
Private Declare Sub wrect Lib "dwg.dll" (ByVal sx As Double, ByVal sy As Double, ByVal ex As Double, ByVal ey As Double)
Private Declare Sub setbaseXY Lib "dwg.dll" (ByVal x As Double, ByVal y As Double)
Private Declare Sub setrbase Lib "dwg.dll" (ByVal x As Double, ByVal y As Double)
Private Declare Sub setscale Lib "dwg.dll" (ByVal xsca As Double)
Private Declare Sub pline Lib "dwg.dll" (ByVal x1 As Double, ByVal y1 As Double, ByVal x2 As Double, ByVal y2 As Double)
Private Declare Function getscale Lib "dwg.dll" () As Double
Private Declare Function getbasex Lib "dwg.dll" () As Double
Private Declare Function getbasey Lib "dwg.dll" () As Double
Private Declare Sub wtext1 Lib "dwg.dll" (ByVal x As Double, ByVal y As Double, ByVal text As String, ByVal dqx As Double, ByVal dqy As Double)
Private Sub Command1_Click()
Dim dwgfilename As String
'dwgfilename = InputBox(" 图形文件名")
dwgfilename = "c:\testdwg"
a = startdwg(dwgfilename)
If a = -1 Then
MsgBox "创建文件错"
End
End If
setbaseXY 0#, 0#
setscale 1#
settextstyle HZ_CMPLX
setlayer "1", Red, HIDDEN
wsolid 100#, 200#, 200#, 200#, 100#, 100#, 200#, 100#
w3dface 100#, 200#, 200#, 200#, 200#, 100#, 100#, 100#
wrect 50, 50, 200, 200
'npline 3, 1#, 10#, 20#, 20#, 100#, 20# '*********
chgcolor Blue
chgltype HIDDEN
wline 1#, 1#, 400#, 402#
chgcolor Yellow
chgltype CONTINUOUS
'ppolygon 4, 25#, 10#, 584#, 10#, 584#, 410#, 25#, 410#
colorbylayer
wcircle 150#, 100#, 40#
wline 0#, 420#, 420#, 0#
settexthigh 25
settextobliq 15
wtext1 10, 10, "aasdsfdsffs", 0, 0
settextstyle HZ_ROMS
wtext1 50#, 50#, "kjhgjksfjksgfjsf", 0, 0
settextrotang 30#
setlayer "zz", Green, HIDDEN
wtext1 10#, 10#, "abcdefa地械棋", 0, 0
setlayer "qq", 2, CONTINUOUS
warc 10#, 10#, 50#, 11#, 125#
wpline 0
wvertex 1.5, 21.5, 1
wvertex 20.4, 12.5, 1
wvertex 13.7, 55.456, 0
wvertex 81.5, 111.5, 1
wvertex 120.4, 90.4, 1
wseqend
setlayer "ss", 1, CONTINUOUS
wline 10#, 10#, 80#, 45#
wdoughnut 50#, 50#, 10#, 20#
wdoughnut 80#, 50#, 0#, 30#
setplinew 5.2, 5.2
wpline 1
setplinew -1#, -1#
wvertex 11.5, 11.5, 1
wvertex 30.4, 32.5, 1
wvertex 43.7, 25.456, 0
wvertex 21.5, 11.5, 0
wseqend
setlayer "11", Blue, CONTINUOUS
wline 0#, 15#, 100#, 15#
cltextset
settextstyle HZ_ROMS
settexthigh 50
wtext1 0, 200, "DWG图形文件生成函数,作者:朱群.", 0, 0
wline 0, 0, 594, 420
wline 0, 0, 0, 420
chgcolor 1
wline 0, 420, 594, 420
wline 594, 420, 594, 0
wline 0, 0, 594, 0
wcircle 100, 200, 100
chgcolor 2
wsolid 100, 200, 200, 200, 100, 100, 200, 100
wpoint 30, 30
enddwg
MsgBox dwgfilename + ".dwg 图形已生成"
End Sub